開発試作品の基板実装をサプライヤに依頼するにあたり、サプライヤに部品を発送することになった際、各部品に部品情報を記載したタグを添付することになった。
部品は100種を超え、手入力でのタグ作成は時間の浪費と判断し、マクロを使ったパーツリストからの一括タグ作成を試みた。
サンプル
今回使うサンプルは下記ボタンから入手可能である。
マクロ本体「Parts_List_and_Output_List.xlsm」を開くと、下のようなウィンドウが表示される。
「Master_List」に掲載された部品情報を印刷用リスト「Tags」に自動で転記する。
転記は、「Master_List」上にある「タグ作成」ボタンをクリックするだけで実行される。
ただし、全て手にするのではなく、あくまで自社への納品確認が済んでおり、かつタグが未出力の部品のみタグを作成する。
コード詳説
マクロの中身は下記のようになっている。
Sub タグ作成()
Dim Model As Long 'マスターシートで型式が掲載されている列番号
Dim Qty As Long 'マスターシートで同梱数が掲載されている列番号
Dim Ref As Long 'マスターシートでリファレンスが掲載されている列番号
Dim Deli As Long 'マスターシートで納品確認が掲載されている列番号
Dim Comp As Long '部品の種類の数
Dim Tag As Long 'リストシートでのタグの列数
Dim i As Long
Dim j As Long
Dim k As Long
'初期値
Model = 1
Qty = 2
Ref = 3
Deli = 4
Out = 5
Comp = 2
j = 1
k = 1
'前情報をクリア
With Worksheets(2)
.Columns(3).ClearContents
.Columns(8).ClearContents
.Columns(13).ClearContents
End With
With Worksheets(3)
.Columns(1).ClearContents
.Columns(2).ClearContents
.Columns(3).ClearContents
End With
'タグ作成分部品リスト作成
Do While Worksheets(1).Cells(Comp, 1).Value <> ""
If Worksheets(1).Cells(Comp, Deli).Value <> "" And Worksheets(1).Cells(Comp, Out).Value = "" Then
With Worksheets(3)
.Cells(j, 1).Value = Worksheets(1).Cells(Comp, Model).Value
.Cells(j, 2).Value = Worksheets(1).Cells(Comp, Qty).Value
.Cells(j, 3).Value = Worksheets(1).Cells(Comp, Ref).Value
End With
Comp = Comp + 1
j = j + 1
Else
Comp = Comp + 1
End If
Loop
'タグ作成
For Tag = 1 To 44
For i = 1 To 3
With Worksheets(2)
.Cells(6 * Tag - 4, 5 * i - 2).Value = Worksheets(3).Cells(k, 1).Value
.Cells(6 * Tag - 3, 5 * i - 2).Value = Worksheets(3).Cells(k, 2).Value
.Cells(6 * Tag - 2, 5 * i - 2).Value = Worksheets(3).Cells(k, 3).Value
End With
k = k + 1
Next
Next
End Sub
まずは、
With Worksheets(2)
.Columns(3).ClearContents
.Columns(8).ClearContents
.Columns(13).ClearContents
End With
With Worksheets(3)
.Columns(1).ClearContents
.Columns(2).ClearContents
.Columns(3).ClearContents
End Withで既に記載されているリストをクリアする。
次に、「Tags」に転記する部品のリストを「List_for_Tag」に作る。
転記する部品の条件は、「Master_List」の「納品確認」列に値があること、かつ「タグ出力済み」列に値が無いことであり、
If Worksheets(1).Cells(Comp, Deli).Value <> "" And Worksheets(1).Cells(Comp, Out).Value = "" Thenで分岐して真であれば
With Worksheets(3)
.Cells(j, 1).Value = Worksheets(1).Cells(Comp, Model).Value
.Cells(j, 2).Value = Worksheets(1).Cells(Comp, Qty).Value
.Cells(j, 3).Value = Worksheets(1).Cells(Comp, Ref).Value
End With
Comp = Comp + 1
j = j + 1で部品情報を「List_for_Tag」に転記する。
偽であれば
Comp = Comp + 1で条件判定対象を次に移す。
これを
Do While Worksheets(1).Cells(Comp, 1).Value <> ""すなわち、「Master_List」1列目の値がなくなる(部品情報の掲載がなくなる)までループする。
ここで満を持して印刷用タグ作成に入る。
タグは1ページに4行3列でフォーマットが並んでいるため、まずは
With Worksheets(2)
.Cells(6 * Tag - 4, 5 * i - 2).Value = Worksheets(3).Cells(k, 1).Value
.Cells(6 * Tag - 3, 5 * i - 2).Value = Worksheets(3).Cells(k, 2).Value
.Cells(6 * Tag - 2, 5 * i - 2).Value = Worksheets(3).Cells(k, 3).Value
End With
k = k + 1で1部品分(1枚分)転記して、それを
For i = 1 To 3で横に3枚分繰り返す。
これで1行目が埋まるので、これを
For Tag = 1 To 44で44行分繰り返す。
本ファイルではタグのフォーマットが44行分あるので、44回繰り返せとした。
これよりも部品の種類が多い場合は、フォーマットをさらに下にコピーして、44より大きい数にすれば良い。
できれば部品数に合わせてタグも増減できるようにしたかったが、マクロが複雑になると考え今回は断念した。
終わりに
久々にマクロを書いたため、最初は時間がかかると思ったが意外とすぐに目当てのものが作れた。
なるべくスキルが退化しないようにしたいが、こればっかりは実践が不可欠なので半ば無理やりにでも実践例を作っていくしかないか。
（そういう意味では電気工事士が一番危ない？）
END
コメント