第23回.納品書を作成、商品情報を取得(1)
エクセルで顧客管理を作ります、
前回までで、「顧客番号」で、「顧客一覧」より情報取得が出来ました、
今回は、明細部の「商品番号」で「商品マスタ」より情報取得します。
今度は、複数行ですので、さらに難しくなります。
本来なら、顧客番号で作成した、コードの使い回しをしたいところですが、別の方法にします。
そこで、全く新しくコードを書きます。
そして、ここで出来たモジュールをコピーして、顧客情報取得へフィードバックします。
かなり面倒な処理になっていますので、
先に、エクセルのサンプル をアップします。サイズが大きくなってきたのでZIPにしました。
また、「納品書」のレイアウトが、明細部は2行づつ使用していましたが、
さすがにプログラムが複雑になり過ぎてしまうので、1行づつに変更しました。
本来、こんなプログラムは作成することは、あまり無いと思います。
今回のプログラムでは、全て可変にしています。
シート名から、シート内のレイアウトまで、出来るだけ自由に変更可能にしました。
また、VLOOKUPの範囲も、B4:O1000とかにすれば簡単なのですが、
あえて、可変範囲を取得して、存在するデータ範囲のみにしたりしています。
レイアウトは頻繁に変更するものではないので、
効率を考えれば、極めて非効率です、変更があったらVBAを変更した方が早そうです。
目的の1つに、いろいろな技術紹介があります。
固定化されたレイアウトでは、ごく一般的な方法のみになってしまうので、わざと難しい設定にしています。
これにより、作成されるコードは、より汎用性が高くなるるはずだとの考えです。
しかし、それによりコードが複雑化して、説明しづらくなっているのも事実です。
「神は乗り越えられる試練しか与えない」ということで、乗り越えましょう。
事前作業
まず、以下を行います。
1.商品番号列に名前定義します。
見出し~10行目に対し、「納品書_商品番号」と名前定義します。
2.以下、「納品書_商品名「」納品書_単位「」納品書_単価「」納品書_備考」
を同様に名前定義します。
3.「商品マスタ」の「商品番号」を可変の名前定義します。
「顧客一覧」の「顧客番号」と同様です。
名前は、「商品番号」
範囲は、=OFFSET(商品マスタ!$B$4,0,0,COUNTA(商品マスタ!$B:$B)-1,1)
4.「商品マスタ」の「商品番号」の見出しセルに名前定義「商品マスタ開始」
Function 開始セル取得(ByVal strSht As String) As Range
Case "商品マスタ"
Set 開始セル取得 = Range("商品マスタ開始")
を追加します。
シート名で使用している先頭セルを返すFunctionですので、
このような修正がある場合は、常に追加していきます。
さて、ここまでは余興みたいなものです。
まず前座です、その前に
「納品書」のシートモジュールです。
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case
True
Case Not Intersect(Target, Range("納品書_顧客番号")) Is Nothing,
_
Not Intersect(Target, Range("納品書_郵便番号")) Is Nothing, _
Not
Intersect(Target, Range("納品書_住所1")) Is Nothing, _
Not
Intersect(Target, Range("納品書_住所2")) Is Nothing, _
Not
Intersect(Target, Range("納品書_顧客名")) Is Nothing, _
Not
Intersect(Target, Range("納品書_担当者名")) Is Nothing
Call
顧客情報取得(Target)
Case Not Intersect(Target, Range("納品書_商品番号")) Is Nothing,
_
Not Intersect(Target, Range("納品書_商品名")) Is Nothing, _
Not
Intersect(Target, Range("納品書_単位")) Is Nothing, _
Not Intersect(Target,
Range("納品書_単価")) Is Nothing, _
Not Intersect(Target, Range("納品書_備考"))
Is Nothing
Call 商品情報取得(Target)
End Select
End
Sub
ここには、顧客情報を取得するべく、VLOOKUPの数式を作成し、セルに設定していました。
元々のプログラムは、その内容は、とりあえずそのままにして、
モジュール名だけを、「顧客情報取得」に変更します。
そして、新たに、上記を作成します。
引数のTargetを「顧客情報取得」に渡しているので、
元々のプログラムは変更せずにそのまま動作します。
これは、良く使う手法です。
引数が同じなら、当然同一コードで同じ動きをします。
1つのモジュールが複雑になった場合に、モジュール分割する際に有効です。
やっている事は、
顧客情報に関するセルが変更された場合は、「顧客情報取得」
商品情報に関するセルが変更された場合は、「商品情報取得」
をCallしているだけです。
さて、真打登場ですい
「納品書」のシートモジュールに以下の2つのモジュール追加。
Private Sub 商品情報取得(ByVal Target As Range)
Dim lngRow As Long, lngCol As
Long '行列の計算用
Dim rngCode As Range '商品番号のセル
Dim rngVlookup As
Range 'Vlookupの範囲
Dim rngMatch As Range 'Matchの検索範囲
Dim
tCell As Range '変更されたセルの取り出し
Dim intLIne As Integer
'明細中の行番号
Application.EnableEvents =
False
Application.Calculation = xlCalculationManual
For Each tCell In
Target
With シート取得("商品マスタ")
intLIne = tCell.Row -
Range("納品書_商品番号").Cells(1, 1).Row + 1
lngRow =
.Range("商品番号").Rows(.Range("商品番号").Rows.Count).Row
lngCol =
.Cells.SpecialCells(xlLastCell).Column
Set rngCode =
Range("納品書_商品番号").Cells(intLIne, 1)
Set rngVlookup =
.Range(.Range("商品番号").Cells(1, 1), _
.Cells(lngRow,
lngCol))
Set rngMatch = .Range(開始セル取得("商品マスタ"),
_
.Cells(.Range("商品マスタ開始").Cells(1, 1).Row,
lngCol))
End With
If Not Intersect(tCell,
Range("納品書_商品番号")) Is Nothing Then
Range("納品書_商品名").Cells(intLIne, 1) =
""
Range("納品書_単位").Cells(intLIne, 1) =
""
Range("納品書_単価").Cells(intLIne, 1) =
""
Range("納品書_備考").Cells(intLIne, 1) = ""
Call
Get商品情報(Range("納品書_商品名").Cells(intLIne, 1), _
"納品書_商品名",
rngCode, rngVlookup, rngMatch)
Call
Get商品情報(Range("納品書_単位").Cells(intLIne, 1), _
"納品書_単位", rngCode,
rngVlookup, rngMatch)
Call Get商品情報(Range("納品書_単価").Cells(intLIne, 1),
_
"納品書_単価", rngCode, rngVlookup, rngMatch)
Call
Get商品情報(Range("納品書_備考").Cells(intLIne, 1), _
"納品書_備考", rngCode,
rngVlookup, rngMatch)
End If
Call Get商品情報(tCell, "納品書_商品名", rngCode, rngVlookup, rngMatch)
Call
Get商品情報(tCell, "納品書_単位", rngCode, rngVlookup, rngMatch)
Call
Get商品情報(tCell, "納品書_単価", rngCode, rngVlookup, rngMatch)
Call
Get商品情報(tCell, "納品書_備考", rngCode, rngVlookup,
rngMatch)
Next
Application.Calculation =
xlCalculationAutomatic
Application.EnableEvents = True
End
Sub
'tCell:対象セル
'strName:名前定義
'rngCode:検索値セル
'rngVlookup:Vlookup範囲
'rngMatch:Match検索範囲
Private
Sub Get商品情報(ByVal tCell As Range, _
ByVal strName As String,
_
ByVal rngCode As Range, _
ByVal rngVlookup As Range,
_
ByVal rngMatch As Range)
Dim lngMatch As Integer
'Matchで取得した列番号
If Intersect(tCell, Range(strName)) Is Nothing Or
_
Not IsEmpty(tCell) Then
Exit Sub
End If
On Error
Resume Next
lngMatch = Application.WorksheetFunction.Match(
_
Range(strName).Cells(1, 1), _
rngMatch,
_
0)
tCell.Value = Application.WorksheetFunction.VLookup(
_
rngCode, _
rngVlookup, _
lngMatch,
_
False)
On Error GoTo 0
End Sub
さて、困りましたね。
どうやって説明しましょうか。
やっている事は、入力された「商品番号」で「商品マスタ」よりVLookUpで取得しているだけなのですが。
前回の顧客情報の取得とは違い、数式をセルに設定するのではなく、
取得した値をセルに設定しています。
おそらく、この方が使い勝手が良いはずです。
では、とにかく、順番に説明します。
For Each tCell In Target
For Eachは、コレクション(集合体)から1つずつオブジェクトを取り出して処理します。
TargetはRangeオブジェクトで、複数の要素を持つので、
For Eachで、セルを順番に処理する事が出来ます。
With シート取得("商品マスタ")
intLIne = tCell.Row - Range("納品書_商品番号").Cells(1, 1).Row +
1
lngRow = .Range("商品番号").Rows(.Range("商品番号").Rows.Count).Row
lngCol =
.Cells.SpecialCells(xlLastCell).Column
Set rngCode =
Range("納品書_商品番号").Cells(intLIne, 1)
Set rngVlookup =
.Range(.Range("商品番号").Cells(1, 1), _
.Cells(lngRow,
lngCol))
Set rngMatch = .Range(開始セル取得("商品マスタ"),
_
.Cells(.Range("商品マスタ開始").Cells(1, 1).Row, lngCol))
End
With
tCellは、For Earchで取り出したセルです。
このtCellの位置情報と、名前定義「商品番号」、名前定義「納品書_商品番号」を基に、
必要なセル範囲を作りだしています。
intLIneには、変更されたセルの明細中の行番号を入れています。
tCellが名前定義「商品番号」の何行目かを求めています。
lngRowには、「商品マスタ」の「商品番号」の最終行が入ります。
名前定義「商品番号」は可変範囲です、この最終行を取得しています。
lngColには、「商品マスタ」の最終列が入ります。
これらの情報を基に、関数で使用するセル範囲を決定しています。
rngCodeには、変更された行の商品番号列のセルが入ります。
rngVlookupには、「商品マスタ」のデータ部の範囲が入ります。
rngMatchには、、「商品マスタ」の見出し部の範囲が入ります。
If Not Intersect(tCell, Range("納品書_商品番号")) Is Nothing
Then
・・・
End If
商品番号が変更された場合は、当該行の「商品名」「単位」「単価」「備考」を消去し、
その後に、それぞれの商品情報を「Get商品情報」で取得しています。
Call Get商品情報(tCell, "納品書_商品名", rngCode, rngVlookup,
rngMatch)
「納品書_商品名」を情報を取得しています。
tCellが変更されたセルです。
tCellが、「商品番号」なら、同一行の「商品名」「単位」「単価」「備考」を取得、
tCellが、「「商品名」「単位」「単価」「備考」なら、tCellにそれぞれの情報を設定します。
Private Sub Get商品情報(ByVal tCell As Range, _
ByVal strName As String, _
ByVal rngCode As
Range, _
ByVal rngVlookup As Range, _
ByVal rngMatch
As Range)
引数は、以下になります。
tCell:対象セル
strName:名前定義
rngCode:検索値セル
rngVlookup:Vlookup範囲
rngMatch:Match検索範囲
この情報を基に、見出しをMatchで検索し、列番号を取得。
そして、VLookupにて、情報を取得しています。
VLookupは、検索値が無い場合は、エラーとなるので、
On Error Resume Next
でエラーを回避しています。
WorksheetFunctionは非常に高速です。
ワークシートの関数が全て使用出来る訳ではありませんので使用するときに確認して下さい。
WorksheetFunctionについては、近いうちに特集します。
概略しか説明していませんので、理解できない部分もあると思います。
複雑な指定は、分解して考えれば良いです。
例えば、
lngRow =
.Range("商品番号").Rows(.Range("商品番号").Rows.Count).Row
では、まず、
Range("商品番号").Rows.Countは行数を返します。
そこで、
lngRow =
.Range("商品番号").Rows(.商品番号の行数).Row
と考えれば良いのです。
これで、商品番号のセル範囲.行位置(商品番号の行数).行番号
となります。
コードを読む時は、分解して読みます。
コードを書くときは、組み合わせて書きます。
イミディエイトで、
一つ一つの要素の内容を確認して読みほどき、
一つ一つの要素の内容を確認して組み合わせて行きます。
もちろん毎回、イミディエイトで確認などしていられませんが、
分からなくなったら、一歩ずつ進むことも必要です。
次回、そのコードを紹介しつつ、再度内容の確認をすることにします。
同じテーマ「エクセル顧客管理」の記事
第20回.納品書を作成、顧客情報を取得(3)
第21回.イベント処理について
第22回.コントールについて
第23回.納品書を作成、商品情報を取得(1)
第24回.納品書を作成、商品情報を取得(2)
第25回.納品書を作成、商品情報を取得(3)
第26回.WorksheetFunctionについて
第27回.RangeとCellsの深遠
第28回.納品書データをデータベース化(1)
第29回.納品書データをデータベース化(2)
第30回.配列の使い方について
新着記事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コードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。