第29回.納品書データをデータベース化(2)
エクセルで顧客管理を作ろう、
前回の続きです、
シート「納品書」で入力した内容を、データベース化します。
前回作業で、「売上明細」の開始セルに名前定義を忘れていました。
A3セルに「売上明細_開始」と名前定義してあります。
「Mod納品書」に、以下の2つを新規追加します。
Sub 売上明細へ登録()
Dim i1 As Long, i2 As Long
Dim lngRow As Long, lngCol
As Long
Dim nm As Name
Dim rtn As Integer
Dim varAry As
Variant
Dim varNo As Variant
rtn = MsgBox("登録してもよろしいですか?",
vbYesNo, "確認")
If rtn = vbNo Then Exit Sub
Call マクロ開始処理
With シート取得("売上明細")
i1 = .Cells(Rows.Count, 2).End(xlUp).Row +
1
i2 = i1 '登録する伝票の、i1:開始行、i2:終了行
'同一伝票を削除する(1加算)
lngCol =
登録列取得("納品書_伝票番号")
varNo = Range("納品書_伝票番号").Value
varAry =
.Range(開始セル取得("売上明細").Offset(1, 0), .Cells(i1 - 1,
.Cells.SpecialCells(xlLastCell).Column))
For lngRow = LBound(varAry) To
UBound(varAry)
If varAry(lngRow, lngCol) = varNo
Then
.Cells(開始セル取得("売上明細").Row + lngRow, 1) =
_
.Cells(開始セル取得("売上明細").Row + lngRow, 1) + 1
End
If
Next
'有効な明細行数分のデータを登録
For lngRow = 2 To
Range("納品書_商品番号").Rows.Count
If Not
IsEmpty(Range("納品書_商品番号").Cells(lngRow, 1)) Then
lngCol =
登録列取得("納品書_行番号")
.Cells(i2, lngCol) = Range("納品書_行番号").Cells(lngRow,
1)
lngCol = 登録列取得("納品書_商品番号")
.Cells(i2, lngCol) =
Range("納品書_商品番号").Cells(lngRow, 1)
lngCol =
登録列取得("納品書_商品名")
.Cells(i2, lngCol) = Range("納品書_商品名").Cells(lngRow,
1)
lngCol = 登録列取得("納品書_数量")
.Cells(i2, lngCol) =
Range("納品書_数量").Cells(lngRow, 1)
lngCol =
登録列取得("納品書_単位")
.Cells(i2, lngCol) = Range("納品書_単価").Cells(lngRow,
1)
lngCol = 登録列取得("納品書_金額")
.Cells(i2, lngCol) =
Range("納品書_金額").Cells(lngRow, 1)
lngCol =
登録列取得("納品書_備考")
.Cells(i2, lngCol) = Range("納品書_備考").Cells(lngRow,
1)
i2 = i2 + 1
End If
Next
i2 = i2 - 1
'1進んでしまっているので、1戻します。
lngCol =
開始セル取得("売上明細").Column
.Range(.Cells(i1, lngCol), .Cells(i2, lngCol)) = 0
'0:有効、>=1:削除
lngCol = 登録列取得("納品書_伝票番号")
.Range(.Cells(i1,
lngCol), .Cells(i2, lngCol)) = Range("納品書_伝票番号").Value
lngCol =
登録列取得("納品書_納品日")
.Range(.Cells(i1, lngCol), .Cells(i2, lngCol)) =
Range("納品書_納品日").Value
lngCol =
登録列取得("納品書_自社担当")
.Range(.Cells(i1, lngCol), .Cells(i2, lngCol)) =
Range("納品書_自社担当").Value
lngCol =
登録列取得("納品書_郵便番号")
.Range(.Cells(i1, lngCol), .Cells(i2, lngCol)) =
Range("納品書_郵便番号").Value
lngCol =
登録列取得("納品書_住所1")
.Range(.Cells(i1, lngCol), .Cells(i2, lngCol)) =
Range("納品書_住所1").Value
lngCol = 登録列取得("納品書_住所2")
.Range(.Cells(i1,
lngCol), .Cells(i2, lngCol)) = Range("納品書_住所2").Value
lngCol =
登録列取得("納品書_顧客名")
.Range(.Cells(i1, lngCol), .Cells(i2, lngCol)) =
Range("納品書_顧客名").Value
lngCol =
登録列取得("納品書_担当者名")
.Range(.Cells(i1, lngCol), .Cells(i2, lngCol)) =
Range("納品書_担当者名").Value
lngCol =
登録列取得("納品書_顧客番号")
.Range(.Cells(i1, lngCol), .Cells(i2, lngCol)) =
Range("納品書_顧客番号").Value
End With
Call マクロ終了処理
MsgBox
("正常に登録されました。")
End Sub
Function 登録列取得(ByVal strName As String) As Long
Dim rngFind As
Range
Dim rngTitle As Range
Dim i As Long, j As Long
i =
シート取得("売上明細").Cells.SpecialCells(xlLastCell).Column _
-
開始セル取得("売上明細").Column
Set rngTitle =
シート取得("売上明細").Range(開始セル取得("売上明細").Offset(-1, 0),
_
開始セル取得("売上明細").Offset(-1, i))
Set rngFind =
rngTitle.Find(What:=strName, _
after:=rngTitle.Cells(1, 1),
_
LookIn:=xlFormulas, _
LookAt:=xlWhole,
_
SearchOrder:=xlByColumns,
_
SearchDirection:=xlNext,
_
MatchCase:=False,
_
MatchByte:=False)
If rngFind Is Nothing
Then
登録列取得 = 0
MsgBox (シート取得("売上明細").Name & "に名前定義" &
strName & "が未設定です。")
Else
登録列取得 = rngFind.Column
End
If
End Function
結構長いですね。
とにかく上から順に説明します。
Sub 売上明細へ登録()
rtn = MsgBox("登録してもよろしいですか?", vbYesNo, "確認")
If rtn = vbNo Then Exit Sub
不要な気もするかもしれませんが、間違って押したり、何度も押したりの防止です。
i1 = .Cells(Rows.Count, 2).End(xlUp).Row + 1
i2 = i1 '登録する伝票の、i1:開始行、i2:終了行
最終行の次行を取得し、i1とi2に入れます。
i1は不変、i2は以下でカウントアップさせます。
lngCol = 登録列取得("納品書_伝票番号")
伝票番号列の取得
varNo = Range("納品書_伝票番号").Value
伝票番号の取得
varAry = .Range(開始セル取得("売上明細").Offset(1, 0), .Cells(i1 - 1,
.Cells.SpecialCells(xlLastCell).Column))
「売上明細」のデータを全て配列に入れる。
For lngRow = LBound(varAry) To UBound(varAry)
If varAry(lngRow, lngCol) = varNo
Then
.Cells(開始セル取得("売上明細").Row + lngRow, 1) = .Cells(開始セル取得("売上明細").Row +
lngRow, 1) + 1
End
If
Next
つまり、削除の数値が、その伝票の履歴番号となります。
0が最新、1が1世代前となります。
どのように使うかは、今後の課題となりますが、世代管理することは重要です。
この一連の処理は、Find~FindNextメソッドでも可能です、その方が、記述が簡単かもしれません。
しかし、「第26回.WorksheetFunctionについて 」でも述べましたが、
どうしても型の問題が残り、その時の修正が大変になってしまいます。
また、1カウントアップではなく、1を入れるだけ等、条件が複数になった場合も困難になります。
このような問題に、機敏に対処する為に、ここでは配列処理をしました。
今後起こりうる問題には、可能な限り事前対処しておくことで、「保守性」を高めます。
For lngRow = 2 To Range("納品書_商品番号").Rows.Count
If Not IsEmpty(Range("納品書_商品番号").Cells(lngRow, 1))
Then
Range("納品書_商品番号")の1行目は見出しですので、2行目から処理しています。
そして、商品番号の入力されている行のみ対象としています。
lngCol = 登録列取得("納品書_行番号")
.Cells(i2, lngCol) = Range("納品書_行番号").Cells(lngRow,
1)
後述の「登録列取得」で、「行番号」の列を取得し、データを登録します。
また、lngColに入れずに、下行のCellsに直接記述も可能ですが、
1行が長くなりすぎてしまい、見づらくなってしまいますので、一旦変数に入れています。
以下、残りの明細項目を全て登録しています。
lngCol = 開始セル取得("売上明細").Column
.Range(.Cells(i1, lngCol), .Cells(i2, lngCol)) = 0
'0:有効、>=1:削除
開始セルは「削除」として固定仕様しています。
「削除」には0、つまり最新データとして登録します。
.Range(.Cells(i1, lngCol), .Cells(i2,
lngCol))
これは、i1行~i2行までを一括処理しています。
上のFor~Nextに入れて1行づつ処理するよりは、効率が良い。
一括処理できる場合は一括で行う、この積み重ねが、全体の処理速度に最も貢献します。
以下、残りの項目を全て登録しています。
MsgBox ("正常に登録されました。")
ソフト作成では、このようなメッセージは重要です。
登録されたのかが分からずに、何度もクリックしないようにしています。
Function 登録列取得(ByVal strName As String) As
Long
引数は、名前定義の名前になります。
i = シート取得("売上明細").Cells.SpecialCells(xlLastCell).Column _
- 開始セル取得("売上明細").Column
見出し部分の列数を計算しています、最終列-開始列です、
下の記述を分かりやすくする為に、事前に計算しておきました。
Set rngTitle = シート取得("売上明細").Range(開始セル取得("売上明細").Offset(-1, 0),
_
開始セル取得("売上明細").Offset(-1,
i))
見出し部分のセル範囲を、変数のRangeオブジェクトに入れています。
これも、下の記述を分かりやすくする為に、事前に変数にしておきました。
Set rngFind = rngTitle.Find(What:=strName, _
after:=rngTitle.Cells(1, 1),
_
LookIn:=xlFormulas, _
LookAt:=xlWhole,
_
SearchOrder:=xlByColumns,
_
SearchDirection:=xlNext,
_
MatchCase:=False,
_
MatchByte:=False)
Functionの引数で、見出し部分を検索しています。
Findの引数は全て指定しています、トラブル回避の為です。
If rngFind Is Nothing Then
登録列取得 = 0
MsgBox (シート取得("売上明細").Name & "に名前定義" &
strName & "が未設定です。")
Else
登録列取得 = rngFind.Column
End
If
見つかった場合は、その列数を返します。
見つからなかった場合は、メッセージで警告します、ただし、シート作成ミスの場合だけです。
これで、売上明細が履歴管理された状態で作成されました。
モジュールはそれなりの長さになっていますが、記述自体は単純です。
項目数自体は、VBAで直接記述しているので、可変にはなっていませんが、
項目の位置、見出し、明細の行数等は可変対応されます。
項目数自体を可変にしてしまうと、ロジックが複雑になり過ぎてしまい、
ブログで紹介出来る範囲を超えてしまうので、この位で良しとしましょう。
さーて、次が問題です。
この「売上明細」を伝票単位で集計し、「売上一覧」を作成しなければなりません。
関数でやるか、マクロでやるか・・・思案しどころです。
マクロでは、処理時間がかかりそうにも思いますし、
関数では、その後の使い勝手が悪そうにも思えるし。
またまた、じっくり考えます。
では、また次回。
同じテーマ「エクセル顧客管理」の記事
第26回.WorksheetFunctionについて
第27回.RangeとCellsの深遠
第28回.納品書データをデータベース化(1)
第29回.納品書データをデータベース化(2)
第30回.配列の使い方について
第31回.売上一覧(伝票合計の一覧)を作成(1)
第32回.売上一覧(伝票合計の一覧)を作成(2)
第33回.売上一覧より納品書を作成
第34回.伝票番号の自動採番機能を追加
第35回.メニューを作成
第36回.最終回
新着記事NEW ・・・新着記事一覧を見る
TRIMRANGE関数(セル範囲をトリム:端の空白セルを除外)|エクセル入門(2024-08-30)
正規表現関数(REGEXTEST,REGEXREPLACE,REGEXEXTRACT)|エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない|エクセル雑感(2024-04-11)
ブール型(Boolean)のis変数・フラグについて|VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する|VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.RangeとCellsの使い方|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.セルのクリア(Clear,ClearContents)|VBA入門
8.メッセージボックス(MsgBox関数)|VBA入門
9.条件分岐(Select Case)|VBA入門
10.マクロとは?VBAとは?VBAでできること|VBA入門
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。