今回はExcelマクロを使った仕入管理システムについての４回目です。
３回目は、入力フォームを使ってマスタデータから「DB」シートに仕入データを（自動計算のうえ）入力する方法を解説しました。
今回は、データベースから指定の年月で抽出して、月次の仕入元帳を作成するコードとプロシージャについて解説します。
紹介している仕入管理システムは、顧客管理、売上管理、在庫管理への転用など汎用性の高いものになっておりますので、ご自身が業務等に使えそうな部分だけでも是非参考にしていただけたらと思います。
（画面設定やブックの保護・解除などシステムとして動作制限をかけるコードについては省略しています。）
VBAコード全体は基本的なものが中心ですので、ご安心ください。それではまいります。
概要
シートは３つあります。
- 「商品マスタ」シート：商品データ（バーコード、商品名、取引先、仕入単価）を登録しておくシートです。
- 「DB」シート：仕入が発生した時に入力しておくシートです。マスタシートからデータ参照して日付、バーコード、取引先名、数量、単価を入力します。バーコードからマスタデータを検索可能です。
- 「仕入帳」シート：月次仕入帳を作成します。DBシートで入力したデータから月次仕入帳を作成します。※今回はここの部分の説明です。
ふりかえり
⑦「検索」ボタンをクリックすると③バーコードテキストボックスに入れた数字から商品を検索・抽出して、⑥リストボックスに表示します。
そして、⑥リストボックスから選択したデータは「DB」シートの最終行に転記されます。
今回のコードの大まかな流れ（仕入帳作成）
- コンボボックスから仕入帳を作成したい年月を選択
- 「仕入帳作成」ボタンをクリックして月次仕入帳を作成する（シート作成）
コード
①コンボボックスへの「年月」の表示
Private Sub UserForm_Initialize()
'解説Ａ
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary") 'ディクショナリを使って、年月のユニーク化
Dim max As Long
Dim i As Long
Dim 日付 As String
Dim 日付var As Variant
max = Sheets("DB").Cells(Sheets("DB").Rows.Count, 2).End(xlUp).Row '最終行取得
With Sheets("DB")
.Range("B5").CurrentRegion.Sort key1:=.Range("B5"), order1:=xlAscending, Header:=xlYes '仕入ＤＢを日付昇順でソート
'解説Ａ
For i = 6 To max
日付 = Left(.Cells(i, 2).Value, 7) '日付の年月までを取り出し
If Not myDic.exists(日付) Then '年月の重複削除
myDic.Add 日付, 日付
End If
Next i
End With
日付var = myDic.items '年月データを一旦バリアント変数に格納（ディクショナリが機能しないため）
'解説Ｂ
cb年月.List = 日付var 'コンボボックスのリストに格納
cb年月.Value = 日付var(0)'コンボボックスの最初の年月を表示
Set myDic = Nothing
End Sub
A、Dictionaryオブジェクト（連想配列）
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")
「DB」シートのデータベースの「日付」フィールドから年月を選択するにあたって、ユニーク化して表示させるためにディクショナリーオブジェクトを生成しています。
ディクショナリーオブジェクトは、主にユニーク化（重複削除）するために使われるオブジェクトであり、生成の方法は２つのあります。
- CreateObjectでDictionaryオブジェクトを生成する（上述の通り）
- Dim 変数名 As Dictionary Set 変数名 = New Dictionaryで生成（参照設定）
２の場合は予め「参照設定」を行う必要があります。
ブックを共有する場合は、共有する側も参照設定する必要があります。ただ、プロパティやメソッドを入力する際に予測変換（インテリセンス機能）を使うことができます。
For i = 6 To max
日付 = Left(.Cells(i, 2).Value, 7)'日付の年月までを取り出し
If Not myDic.exists(日付) Then '年月の重複削除
myDic.Add 日付, 日付
End If
Next i
「DB」シートの６行目から最終行までループします。
Existsメソッド
Dictionaryオブジェクト.Exists（キー）
DictionaryオブジェクトのExistsメソッドを使って重複のチェックを行います。
Existsメソッド・・・キーが存在していればTrue、存在していなければFalseを返してくれます。
Addメソッド
Dictionaryオブジェクト.Addキー,要素
そもそもDictionaryオブジェクトはキーと要素を紐づけて重複なしのデータ一覧を作成していきます。
Dictionaryオブジェクトにそのキーと要素を追加するのがAddメソッドというわけです。
よって、If文のExistsメソッドを使って、キーの存在の有無を確認して、存在していなければ追加されるというわけです。
Existsメソッドを使用しない場合
そもそもDictionaryオブジェクトは辞書機能であり、重複をなくしてくれるものなので、下記のようなコードを使ってもキーに要素を追加できます。その場合は、重複が発生すれば上書きされます。
上書きしたくない場合は、Existsメソッドを使います。結果は同じです。
myDic(日付) = 日付
B、Dictionaryオブジェクトのitemsメソッド・コンボボックスのListプロパティ
itemsメソッド・・・Dictionaryオブジェクトの全ての要素を配列で返します。
LIstプロパティ・・・コンボボックスに値を設定します。
日付var(0)・・・変数ですが、配列の最初のデータです。
日付var = myDic.items '年月データを一旦バリアント変数に格納（ディクショナリが機能しないため）
cb年月.List = 日付var 'コンボボックスのリストに格納
cb年月.Value = 日付var(0) 'コンボボックスの最初の年月を表示
こちらのプロシージャはイニシャライズなので、ユーザーフォームが立ち上がる時に実行される処理です。
②仕入帳作成
Private Sub 仕入帳btn_Click()
Dim i As Long
Dim max As Long, max2 As Long
Dim 転記日付 As String
Dim ws As Worksheet
Dim サーチシート As Worksheet
Dim シート名 As String
Application.DisplayAlerts = False
If MsgBox(cb年月.Text & vbCrLf & "仕入帳を作成しますか？", vbYesNo + vbQuestion) <> vbYes Then Exit Sub '確認メッセージボックス
max = Sheets("DB").Cells(Sheets("DB").Rows.Count, 2).End(xlUp).Row 'DBシート最終行取得
With Sheets("DB")
'解説Ａ
Sheets("仕入帳").Copy after:=Sheets("仕入帳")
Set ws = ActiveSheet
シート名 = Replace(cb年月.Text, "/", "") '月次仕入帳の新規シート作成
For Each サーチシート In Worksheets
If サーチシート.Name Like シート名 Then '同じ年月シートがあれば
サーチシート.Delete '削除
End If
Next サーチシート
ws.Name = シート名
ws.Shapes("ボタン").Delete '新規
ws.Range("C2").Value = Left(シート名, 4) '仕入元帳の年代
ws.Range("E2").Value = Right(シート名, 2) '仕入元帳の月
For i = 6 To max
転記日付 = Left(.Cells(i, 2).Value, 7) 'DBシートの日付フィールド年月の抜き取り
If 転記日付 Like cb年月.Text Then '上記抜き取った年月とcb年月コンボボックスが合致すれば
max2 = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row + 1 '仕入帳の最終行の一行下
ws.Cells(max2, 1) = .Cells(i, 2).Value '日付
ws.Cells(max2, 2) = .Cells(i, 3).Value 'バーコード
ws.Cells(max2, 3) = .Cells(i, 5).Value '商品名
ws.Cells(max2, 6) = .Cells(i, 7).Value '数量
ws.Cells(max2, 8) = .Cells(i, 6).Value '単価
ws.Cells(max2, 9) = .Cells(i, 8).Value '金額
End If
Next i
End With
Application.DisplayAlerts = True
End Sub
A、シートのコピー
Sheets("仕入帳").Copy after:=Sheets("仕入帳")
Set ws = ActiveSheet
シート名 = Replace(cb年月.Text, "/", "") '月次仕入帳の新規シート作成
For Each サーチシート In Worksheets
If サーチシート.Name Like シート名 Then '同じ年月シートがあれば
サーチシート.Delete '削除
End If
Next サーチシート
- 仕入帳シートをコピーします。
- シート名はコンボボックスのデータから”/”を抜き取ります。
- ワークブックに同じシート名があれば、削除します。
それ以降は、抽出されたデータベースのデータを仕入シートに転記していき、指定の月次の仕入帳を作成します。
③閉じる
Private Sub 閉じるbtn_Click()
Unload 仕入帳作成フォーム
End Sub
まとめ
４回にわたって仕入管理システムの解説を行っていきました。是非、参考にしてみてください。
コメント