エクセル顧客管理 | 第23回.納品書を作成、商品情報を取得(1) | Excelマクロを駆使したカスタマイズ可能なエクセル顧客管理、エクセルVBAの学習教材



最終更新日:2014-11-11

第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
と考えれば良いのです。

これで、商品番号のセル範囲.行位置(商品番号の行数).行番号

となります。


コードを読む時は、分解して読みます。

コードを書くときは、組み合わせて書きます。


イミディエイトで、

一つ一つの要素の内容を確認して読みほどき、

一つ一つの要素の内容を確認して組み合わせて行きます。

もちろん毎回、イミディエイトで確認などしていられませんが、

分からなくなったら、一歩ずつ進むことも必要です。



「顧客情報取得」のモジュールについては、ほぼ同様になります。

次回、そのコードを紹介しつつ、再度内容の確認をすることにします。


では、また、次回に!






同じテーマ「エクセル顧客管理」の記事

第24回.納品書を作成、商品情報を取得(2)
第25回.納品書を作成、商品情報を取得(3)
第26回.WorksheetFunctionについて
第27回.RangeとCellsの深遠
第28回.納品書データをデータベース化(1)
第29回.納品書データをデータベース化(2)
第30回.配列の使い方について

新着記事 ・・・新着記事一覧を見る

SUMIFの間違いによるパフォーマンスの低下について|エクセル関数超技(6月17日)
条件式のいろいろな書き方:TrueとFalseの判定とは|ExcelマクロVBA技術解説(6月15日)
空白セルを正しく判定する方法2|ExcelマクロVBA技術解説(5月6日)
フルパスをディレクトリ、ファイル名、拡張子に分ける|ExcelマクロVBA技術解説(4月15日)
テキストボックスの各種イベント|Excelユーザーフォーム入門(4月9日)
フォルダ(サブフォルダも全て)削除する、Optionでファイルのみ削除|ExcelマクロVBAサンプル集(4月4日)
最後の空白(や指定文字)以降の文字を取り出す|エクセル関数超技(3月26日)
先頭の数値、最後の数値を取り出す|エクセル関数超技(3月26日)
Excelファイルを開かずにシート名をチェック|ExcelマクロVBAサンプル集(3月23日)
数式の参照しているセルを取得する|ExcelマクロVBAサンプル集(3月18日)

アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|ExcelマクロVBA入門
2.RangeとCellsの使い方|ExcelマクロVBA入門
3.徹底解説(VLOOKUP,MATCH,INDEX,OFFSET)|エクセル関数超技
4.Range以外の指定方法(Cells,Rows,Columns)|ExcelマクロVBA入門
5.変数とデータ型(Dim)|ExcelマクロVBA入門
6.セルのコピー&値の貼り付け(PasteSpecial)|ExcelマクロVBA入門
7.セルの参照範囲を可変にする(OFFSET,COUNTA,MATCH)|エクセル関数超技
8.ひらがな⇔カタカナの変換|エクセル基本操作
9.定数と型宣言文字(Const)|ExcelマクロVBA入門
10.CSVの読み込み方法|ExcelマクロVBAサンプル集



  • >
  • >
  • >
  • 納品書を作成、商品情報を取得(1)

  • このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


    記述には細心の注意をしたつもりですが、
    間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
    なお、掲載のVBAコードは自己責任で使ってください。万一データ破損等の損害が発生しても責任は負いません。

    ↑ PAGE TOP