2017年10月6日金曜日

ビジュアルベーシックで、連想配列を実用的に使いこなせる、基本的なMRPのサンプルファイルを完成させたぜ - エクセルVBA(そのほか)


9月末の投稿で、分かった気になって連想配列をプログラムしてみたと書きました。
ただ、参考になったネタ元のサンプルが存在したのは事実で、少し気が引けます。

だから、連想配列の定義を、今一度、よく咀嚼して、プログラミングに挑戦なのだ。
自分的には、キーから値を取り出す手法が、今一度よく飲み込めないでいました。

元来、サンプルプログラムを見つけると、分かったつもりで走らせて見ようと致します。
これが、単純なコードですと、組み込んでも完走してくれたので、慢心していました。

まあ、VBAの良さは、実行中のコードにバグがあれば、万が一は自動で止まります。
それで、動かせて見ますが、今回の連想配列では、想定した動きをしてくれません。

何か変と思いましたが、インデックス番号がゼロから開始するのを知りませんでした。
そんなささいなことが積み重なりますが、究極はキーを使った値の取出しのつまずき。

基本的にネットで資料を探して理解しようとしますが、中途半端と思い始めました。
このため、少し放置して、他の手法でプログラミングして成果を出すことにします。

仕事も機敏に方針転換できれば、良い結果につながることが、ままあるものです。
なので、連想配列を捨て、穏当に検索関数のMatchを使って、BOMは完成です。

考えてみるに、この配列はエクセルの表から、もう一度データベースを作り直します。
このため、辞書のデザインが必要ですが、メモリに配置するので検索が高速なんだ。

しかも、複数セルを結び合わせた文字列データを、検索キーにできるのがメリット。
一方、作ろうとしたBOMは、検索のセル値が、所々、歯抜けのようにブランクです。

この空白セルが複数であるのなら、ぴったりと探すには、何か別のアイデアも必要。
ただ、この手の検索の工程はロジックが複雑になるので、なるべくシンプルにしたい。

まあ、これを避けるために、合成した文字列の検索キーが効果的と判断した次第。
ただ、キーから値を取り出す手法がよく分からないままで、作業を中断していました。

うーん、配列作りのコツも飲み込めずに、放り投げてしまうのは何とももったいない。
ここは、二千件のデータをまとめたBOM も完成したことだし、連想配列版を作ろう。

こうして、今一度、配列の定義を見直して熟考したら、あっさりとできてしまいました。
なので、サンプル版を公開しますので、そのコードのロジックを参考にしてみて下さい。

クリックで拡大してご覧ください

これらのファイルで、マクロが組まれたのは二つで、多少マクロの性格が異なります。
BOMのマスターファイルは、仕掛品の所要パーツが、シート別に分けられています。

そして、ファイルを開いた時に、各シートのデータを一枚目に集結させるコードです。
二つ目の生産部材調達用のファイルですが、ここに連想配列が活用されています。

このファイルを開くと、先ず生産用のBOMとBOMのマスターファイルが開かれます。
この二つのファイルから、共通なデータが抽出され、コスト(原価)を算出しています。

もし、BOMのマスターファイルが、常に最新の価格情報で整理されているとします。
そして、経理的に生産機種の原価を求めたいのなら、最新情報が参照できます。

こういった工程は、資材所要量計画(MRP)を策定するための出発点になるはず。
ですので、小規模な工場の生産活動にエクセルで可能なのか、ちょっと試しました。

というわけで、この連想配列は思わぬ弱点がありまして、キーが重複できないのだ。
これを知らないで実行すると、”実行時エラー 457 : このキーは既にコレクション内の要素に関連付けられています。”とエラー画面が現れてしまい、原因を突き止めるのに、VBAエディターのイミディエート画面からDebug.Printの結果を見て判断したりしましたが、元はと言えば一物一価にならないBOMデータベースの精度が理由なのでして、サンプルコードはいずれ使う時がやってくるのかもしれないとも思うのでした。


<サンプルコード>

★ファイルのダウンロードはこちらから

=マクロコード → PURCHASE_BOM.xlsm=

◎ThisWorkbookのプロシージャ

Private Sub Workbook_Open()

Dim WrkBkPth As String
Dim x As Worksheet
Dim y As Worksheet
Dim z As Worksheet

WrkBkPth = ThisWorkbook.Path
Workbooks.Open Filename:=WrkBkPth & "\" & "PRODUCT_BOM.xlsx"
Workbooks.Open Filename:=WrkBkPth & "\" & "MASTER_BOM.xlsm"
'生産用・価格マスター用のBOMオープン

Set x = Workbooks(2).Worksheets(1)
Set y = Workbooks(1).Worksheets(1)
Set z = Workbooks(3).Worksheets(1)
'ワークシートオブジェクトの変数定義

x.Range("A1:D1000").Copy
y.Range("A1:D1000").PasteSpecial Paste:=xlPasteAll
'セル範囲のコピーペースト

z.Cells(1, 4).Copy
y.Cells(1, 5).PasteSpecial Paste:=xlPasteAll
'セル範囲のコピーペースト(価格見出し)

Call DictSearch
'プロ-ジャの呼び出し実行

Application.DisplayAlerts = False     '確認メッセージ非表示
Workbooks(2).Close SaveChanges:=False '保存せずに終了
Workbooks(2).Close SaveChanges:=False '確認メッセージ表示復帰
Application.DisplayAlerts = True

y.Cells(1, 1).Select

Set x = Nothing
Set y = Nothing
Set z = Nothing
'変数定義のメモリー領域開放

End Sub

◎モジュール1のプロシージャ

Sub DictSearch()

Dim RowNr As Long
Dim i As Long
Dim j As Long
Dim Dict As Object
Dim ItemValue As Variant
Dim ItemValue2 As Variant
Dim Strng As String
Dim x As Worksheet
Dim y As Worksheet
Dim z As Worksheet

Application.ScreenUpdating = False
'セルの複写・貼付けを画面表示しない(高速化)

Set x = Workbooks(2).Worksheets(1)
Set y = Workbooks(1).Worksheets(1)
Set z = Workbooks(3).Worksheets(1)
Set Dict = CreateObject("Scripting.Dictionary")
'連想配列(辞書)等のオブジェクト変数定義

RowNr = x.Cells(Rows.Count, 1).End(xlUp).Row
'ブック(2)の最終行番号を求める

For i = 2 To RowNr  '見出し行の次から開始
ItemValue = x.Cells(i, 1) & x.Cells(i, 2) & x.Cells(i, 3)
Dict.Add ItemValue, i

'Debug.Print ItemValue & i
'このデバッグは、イミディエートウインドウ確認用

Next i
'ForNext文でブック(2)の辞書作成、A-C列結合がキー、行番号が値

'----ブック(3)のA-C列結合:キーにより辞書を検索----

RowNr = z.Cells(Rows.Count, 1).End(xlUp).Row
'ブック(3)の最終行番号を求める

For j = 2 To RowNr
ItemValue2 = z.Cells(j, 1) & z.Cells(j, 2) & z.Cells(j, 3)

If Dict.Exists(ItemValue2) = True Then
Strng = Dict.Item(ItemValue2)

z.Cells(j, 4).Copy
y.Cells(Val(Strng), 5).PasteSpecial Paste:=xlPasteAll
End If
'If文により、A-C列結合キーから、それに合う値(行番号)を取得
'該当価格のセルコピー・値を数値化してシート(1)該当セルへ貼付

Next j
'ForNext文でブック(3)の辞書検索を繰り返し実行

Set Dict = Nothing
Set x = Nothing
Set y = Nothing
Set z = Nothing

Call CostCalc

Application.ScreenUpdating = True
'セルの複写・貼付けを画面表示に復帰

End Sub

◎モジュール2のプロシージャ

Sub CostCalc()

Dim RowNr As Long
Dim i As Long

With Workbooks(1).Worksheets(1)

RowNr = .Cells(Rows.Count, 1).End(xlUp).Row
'ブック(1)A列の最終行番号を求める

For i = 2 To RowNr

.Cells(i, 6).Value = .Cells(i, 4).Value * .Cells(i, 5).Value

Next i
'ForNext文による各部品のコスト計算

.Cells(RowNr + 1, 5).Font.Name = "Arial"
.Cells(RowNr + 1, 5) = "TOTAL :"
.Cells(RowNr + 1, 6) = WorksheetFunction.Sum(Range(.Cells(2, 6), .Cells

(RowNr, 6)))
'最終行にて原価算出

.Columns("A:E").AutoFit
'シート(1)列幅の調整

End With

End Sub

=マクロコード → MASTER_BOM.xlsm=

◎ThisWorkbookのプロシージャ

Private Sub Workbook_Open()

Call WhetherToCompile

End Sub

◎モジュール1のプロシージャ
Sub WhetherToCompile()

Dim rc As String
Dim Filename As String

Application.ScreenUpdating = False
'マクロ実行を画面表示しない

Worksheets("Master").Activate
Range("2:5000").Delete
Cells(1.1).Select
'マスターシートをアクティブ化、見出し以外のデータを削除

Filename = ActiveWorkbook.Name

If Filename <> "MASTER_BOM.xlsm" Then
GoTo CONTINUE
End If

'ブックメンテ用にBOMマスターを読み込まない分岐命令

    rc = MsgBox("作業を始めますか?", vbYesNo + vbQuestion, "コンパイル")
    If rc = vbYes Then

Call CompileStart

    Else

MsgBox "各シートのデータは、" & vbNewLine & "読み込んでいません。"

    End If

CONTINUE:

Application.ScreenUpdating = True
'マクロ実行を画面表示する

End Sub
---------------------------------------------
Sub CompileStart()

Dim i As Integer
Dim ColumnEnd As Integer
Dim SheetRowEnd As Integer
Dim SheetRowEnd2 As Integer
Dim SheetNr As Integer
Dim SheetNr2 As Integer
'変数宣言

SheetNr = Worksheets.Count
'マスターに貼り付けるワークシートの数

For i = 2 To SheetNr
'ForNext文で、マスターに貼り付けるシートの数を繰り返し

SheetNr2 = i
'マスターに貼り付けるシート番号

SheetRowEnd = Worksheets(SheetNr2).Cells(Rows.Count, 1).End(xlUp).Row
'マスターに貼り付けるシートのデータ行を見出しでカウント
ColumnEnd = Worksheets(SheetNr2).Range("A1").End(xlToRight).Column
'マスターに貼り付けるシートのデータ列を見出しでカウント

SheetRowEnd2 = Worksheets("Master").Cells(Rows.Count, 1).End(xlUp).Row + 1
'マスターにデータ貼付後、次のシート貼付の行数を特定

Worksheets(SheetNr2).Activate
'マスターに貼り付けるシートのアクティブ化
ActiveSheet.Range(Cells(2, 1), Cells(SheetRowEnd, ColumnEnd)).Select
'データ行を抽出
Selection.Copy
'データ行をコピー
Cells(1.1).Select
'念のため、アクティブシートのセル選択

Worksheets("Master").Activate
'マスターシートのアクティブ化
ActiveSheet.Cells(SheetRowEnd2, 1).Select
'データを貼り付ける位置の指定
ActiveSheet.Paste
'コピーされたデータの貼り付け

'メッセージ表示を戻す
Application.DisplayAlerts = False

ActiveCell.Select
'マスターシートのセル(1,1)を選択

Next
'繰り返し実行

End Sub



いいねと思ったら、二つポチっとね!



0 件のコメント:

コメントを投稿