Excelマクロ(VBA)で作る管理システム④

Excel
スポンサーリンク

今回はExcelマクロを使った仕入管理システムについての4回目です。

3回目は、入力フォームを使ってマスタデータから「DB」シートに仕入データを(自動計算のうえ)入力する方法を解説しました。

今回は、データベースから指定の年月で抽出して、月次の仕入元帳を作成するコードとプロシージャについて解説します。

紹介している仕入管理システムは、顧客管理、売上管理、在庫管理への転用など汎用性の高いものになっておりますので、ご自身が業務等に使えそうな部分だけでも是非参考にしていただけたらと思います。
(画面設定やブックの保護・解除などシステムとして動作制限をかけるコードについては省略しています。)
VBAコード全体は基本的なものが中心ですので、ご安心ください。それではまいります。

Excelマクロ(VBA)で作る管理システム①
マクロ(VBA)で仕入管理システムを作成する方法を紹介しています。使用しているコードやユーザーフォームは仕入だけではなく在庫管理や売上管理、顧客管理など汎用性の高いコードです。是非ご自身の業務に活用してください。
Excelマクロ(VBA)で作る管理システム②
マクロ(VBA)で仕入管理システムを作成する方法の2回目です。使用しているコードやユーザーフォームは仕入だけではなく在庫管理や売上管理、顧客管理など汎用性の高いコードです。是非ご自身の業務に活用してください。
Excelマクロ(VBA)で作る管理システム③
マクロ(VBA)で仕入管理システムを作成する方法の3回目です。ユーザーフォームのリストボックスの詳しい説明やワークシートへのデータの転記方法を解説しています。使用しているコードやユーザーフォームは仕入だけではなく在庫管理や売上管理、顧客管理など汎用性の高いコードです。是非ご自身の業務に活用してください。
スポンサーリンク

概要

完成図①
完成図②

シートは3つあります。

  1. 「商品マスタ」シート:商品データ(バーコード、商品名、取引先、仕入単価)を登録しておくシートです。
  2. 「DB」シート:仕入が発生した時に入力しておくシートです。マスタシートからデータ参照して日付、バーコード、取引先名、数量、単価を入力します。バーコードからマスタデータを検索可能です。 
  3. 「仕入帳」シート:月次仕入帳を作成します。DBシートで入力したデータから月次仕入帳を作成します。※今回はここの部分の説明です。

ふりかえり

仕入商品入力フォーム

⑦「検索」ボタンをクリックすると③バーコードテキストボックスに入れた数字から商品を検索・抽出して、⑥リストボックスに表示します。

検索ボタンの機能

そして、⑥リストボックスから選択したデータは「DB」シートの最終行に転記されます。

仕入データ入力

今回のコードの大まかな流れ(仕入帳作成)

  1. コンボボックスから仕入帳を作成したい年月を選択
  2. 「仕入帳作成」ボタンをクリックして月次仕入帳を作成する(シート作成)

コード

ユーザーフォーム

①コンボボックスへの「年月」の表示


Private Sub UserForm_Initialize()
'解説A
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 '仕入DBを日付昇順でソート
'解説A
    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 '年月データを一旦バリアント変数に格納(ディクショナリが機能しないため)
'解説B
    cb年月.List = 日付var 'コンボボックスのリストに格納
    
    cb年月.Value = 日付var(0)'コンボボックスの最初の年月を表示
    Set myDic = Nothing
End Sub

A、Dictionaryオブジェクト(連想配列)


Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary") 

「DB」シートのデータベースの「日付」フィールドから年月を選択するにあたって、ユニーク化して表示させるためにディクショナリーオブジェクトを生成しています。

ディクショナリーオブジェクトは、主にユニーク化(重複削除)するために使われるオブジェクトであり、生成の方法は2つのあります。

  1. CreateObjectでDictionaryオブジェクトを生成する(上述の通り)
  2. Dim 変数名 As Dictionary Set 変数名 = New Dictionaryで生成(参照設定)

2の場合は予め「参照設定」を行う必要があります。

参照設定
参照設定

ブックを共有する場合は、共有する側も参照設定する必要があります。ただ、プロパティやメソッドを入力する際に予測変換(インテリセンス機能)を使うことができます。


For i = 6 To max
        日付 = Left(.Cells(i, 2).Value, 7)'日付の年月までを取り出し
        If Not myDic.exists(日付) Then '年月の重複削除
            myDic.Add 日付, 日付
        End If
Next i

「DB」シートの6行目から最終行までループします。

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")

'解説A
    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 サーチシート
  1. 仕入帳シートをコピーします。
  2. シート名はコンボボックスのデータから”/”を抜き取ります。
  3. ワークブックに同じシート名があれば、削除します。

それ以降は、抽出されたデータベースのデータを仕入シートに転記していき、指定の月次の仕入帳を作成します。

③閉じる


Private Sub 閉じるbtn_Click()
    Unload 仕入帳作成フォーム
End Sub

まとめ

4回にわたって仕入管理システムの解説を行っていきました。是非、参考にしてみてください。

コメント

タイトルとURLをコピーしました