課題内容
VBA勉強会の課題で主キーを作成する列を追加し、VLOOKUP関数やIF関数をネストさせて作成していたマスターテーブルをVBA化するというもの。
検索結果帳票データに対して、帳票マスターデータのレイヤ名を割り当てていき、別シートに出力する。もし、鄭号するものがなかったら、レイヤ名をレイヤなしと設定する。主キーを作成するには、ファイル名、枠名、レイヤ番号を結合しないと一意にならないものとする。
出力イメージはこのような感じ
コード内容１
Option Explicit
Sub MastarTable()
'シート
Dim wsData As Worksheet: Set wsData = ThisWorkbook.Sheets("データ")
Dim wsOutput As Worksheet: Set wsOutput = ThisWorkbook.Sheets("出力先")
'一意のキー
Dim key1, key2 As Variant
'一意のキーと、レイヤー名を格納
Dim arrMaster As Variant
'カウンタ
Dim i As Long, j As Long
'最終行
Dim lastRow1 As Long, lastRow2 As Long
wsData.Select
'-------------------------------検索結果帳票データ-------------------------------
lastRow1 = wsData.Cells(Rows.count, 2).End(xlUp).Row
ReDim key1(lastRow1 - 3)
'3列分を一意のキーとして検索に使うため、アンスコ区切りでkey1に格納
For i = 0 To lastRow1 - 3
key1(i) = WorksheetFunction.TextJoin("_", True, Range(Cells(i + 3, 2), Cells(i + 3, 4)))
Next
'-------------------------------帳票マスターデータ-------------------------------
lastRow2 = wsData.Cells(Rows.count, 5).End(xlUp).Row
ReDim key2(lastRow2 - 3)
'3列分を一意のキーとして検索に使うため､アンスコ区切りでkey2に格納
For i = 0 To lastRow2 - 3
key2(i) = WorksheetFunction.TextJoin("_", True, Range(Cells(i + 3, 5), Cells(i + 3, 7)))
Next
'--------------------------------結合-------------------------------
ReDim arrMaster(lastRow1 - 3, 1)
'key1とkey2の数だけ繰り返し
For i = 0 To lastRow1 - 3
For j = 0 To lastRow2 - 3
'もしkey1とkey2が一致したらarrMaster(i, 0)に格納
If key1(i) = key2(j) Then
arrMaster(i, 0) = key1(i)
'もしkey2のレイヤに当たるセルが空白だったらレイヤーなしとする
If Cells(j + 3, 8) = "" Then
arrMaster(i, 1) = "レイヤーなし"
Else
'値が入っていればその値を格納
arrMaster(i, 1) = Cells(j + 3, 8).Value
End If
'適合したら抜ける
Exit For
End If
Next
Next
'--------------------------------出力-------------------------------
wsOutput.Select
'作成したマスタデータをセルに出力
For i = 3 To lastRow1
'配列の（i,0）はアンスコ区切りの文字列をsplitしてセルに出力
wsOutput.Range(Cells(i, 1), Cells(i, 3)) = Split(arrMaster(i - 3, 0), "_")
'配列の(i,1)はそのままセルに出力
wsOutput.Cells(i, 4) = arrMaster(i - 3, 1)
Next
End Sub
処理の流れ
検索結果帳票データの方と、帳票マスターデータで行数が違うため、それぞれの最終行を取得して、最終行まで、'_'区切りでそれぞれ結合し、作成したキーを配列に格納します。
結合フェーズでは作成した主キー同士をFor文で繰り返し比較し、適合したら主キーをマスターデータ用の配列に格納します。さらに、適合した該当ループでの帳票マスターデータのレイヤ名もマスターデータ用の配列に格納します。
出力フェーズでは3列を'_'区切りで結合した主キーをsplitして３列に分割し、転記する。
レイヤ名も転記する。
で以上となります。
コード2
ロジック自体はほとんど同じですが、セル範囲をコードで取得するのではなく、インプットフォームから取得する方法も試しに作成しました。ただ、指定するのはめんどくさいですし、使うメリットはなさそうです(笑)
動作イメージはこちら
Option Explicit
Option Base 1
'セル選択バージョン
Sub MastarTable()
'シート
Dim wsData As Worksheet: Set wsData = ThisWorkbook.Sheets("データ")
Dim wsOutput As Worksheet: Set wsOutput = ThisWorkbook.Sheets("出力先")
'一意のキー
Dim key1, key2 As Variant
'一意のキーと、レイヤー名を格納
Dim arrMaster As Variant
'カウンタ
Dim i As Long, j As Long
Dim arr1 As Variant, arr2 As Variant
'セル範囲を選択する
Dim rng1 As Range, rng2 As Range
'セル範囲を選択した行数を格納
Dim r1 As Long, r2 As Long
'セル範囲選択ダイヤログから取得
Set rng1 = Application.InputBox(Prompt:="検索帳票データのセルを選択してください。", Type:=8)
Set rng2 = Application.InputBox(Prompt:="帳票マスターデータのセルを選択してください。", Type:=8)
'Rangeオブジェクトを配列に格納
arr1 = rng1.Value
arr2 = rng2.Value
'配列の１次元目要素数を取得
r1 = UBound(arr1)
r2 = UBound(arr2)
'-------------------------------検索結果帳票データ-------------------------------
ReDim key1(r1)
'3列分を一意のキーとして検索に使うため、アンスコ区切りでkey1に格納
For i = 1 To r1
key1(i) = WorksheetFunction.TextJoin("_", True, arr1(i, 1), arr1(i, 2), arr1(i, 3))
Next
'-------------------------------帳票マスターデータ-------------------------------
ReDim key2(r2)
'3列分を一意のキーとして検索に使うため､アンスコ区切りでkey2に格納
For i = 1 To r2
key2(i) = WorksheetFunction.TextJoin("_", True, arr2(i, 1), arr2(i, 2), arr2(i, 3))
Next
'-------------------------------結合-------------------------------
ReDim arrMaster(r1, 4)
'key1とkey2の数だけ繰り返し
For i = 1 To r1
For j = 1 To r2
'もしkey1とkey2が一致したらKey1をarrMaster(i, 0)に格納
If key1(i) = key2(j) Then
arrMaster(i, 1) = arr1(i, 1)
arrMaster(i, 2) = arr1(i, 2)
arrMaster(i, 3) = arr1(i, 3)
'もしkey2のレイヤに当たるセルが空白だったらレイヤーなしとする
If arr2(j, 4) = "" Then
arrMaster(i, 4) = "レイヤーなし"
Else
'値が入っていればその値を格納
arrMaster(i, 4) = arr2(j, 4)
End If
'適合したら抜ける
Exit For
End If
Next
Next
'-------------------------------出力-------------------------------
'
wsOutput.Select
Set rng3 = Application.InputBox(Prompt:="出力したいセル（左上のみ）を選択してください。", Type:=8)
rng3.Resize(UBound(arrMaster), UBound(arrMaster, 2)) = arrMaster
End Sub
説明
インプットボックスの引数に8を与えるとセル範囲を指定することができるようです。
'セル範囲選択ダイヤログから取得
Set rng1 = Application.InputBox(Prompt:="検索帳票データのセルを選択してください。", Type:=8)
Set rng2 = Application.InputBox(Prompt:="帳票マスターデータのセルを選択してください。", Type:=8)
Rangeオブジェクトでかえってくるため、配列に変換して取りまわしていきます。
また、ループ回数用に行数に当たる配列の一次元目の要素数を取得しておきます。
'Rangeオブジェクトを配列に格納
arr1 = rng1.Value
arr2 = rng2.Value
'配列の１次元目要素数を取得
r1 = UBound(arr1)
r2 = UBound(arr2)
先ほどは紹介していませんでしたが、WorksheetFunctionのTextJoinは区切り文字を設定して文字を結合することができます。また、Concat関数やjoin関数でも似たようなことができますが２次元配列の結合は出来ない仕様です。セル範囲は一列や一行で指定しても２次元扱いなので使用することができません。ですが、このTextJoin関数は可能となっております。
また、&で無理やり結合する方法もありますが、処理速度にかなり影響がでるようです。
後はマスターデータ用の配列に格納して出力という形になります。
split関数使用せず、最小から分割された形で格納するように変更してました。
そして、最後に出力先のセルの一番左上を指定し、そこに配列の大きさ分だけセルをリサイズして一括転記しています。
'-------------------------------結合-------------------------------
ReDim arrMaster(r1, 4)
'key1とkey2の数だけ繰り返し
For i = 1 To r1
For j = 1 To r2
'もしkey1とkey2が一致したらKey1をarrMaster(i, 0)に格納
If key1(i) = key2(j) Then
arrMaster(i, 1) = arr1(i, 1)
arrMaster(i, 2) = arr1(i, 2)
arrMaster(i, 3) = arr1(i, 3)
'もしkey2のレイヤに当たるセルが空白だったらレイヤーなしとする
If arr2(j, 4) = "" Then
arrMaster(i, 4) = "レイヤーなし"
Else
'値が入っていればその値を格納
arrMaster(i, 4) = arr2(j, 4)
End If
'適合したら抜ける
Exit For
End If
Next
Next
'-------------------------------出力-------------------------------
'
wsOutput.Select
Set rng3 = Application.InputBox(Prompt:="出力したいセル（左上のみ）を選択してください。", Type:=8)
rng3.Resize(UBound(arrMaster), UBound(arrMaster, 2)) = arrMaster
終わり
Pythonならデータフレームをがっちゃんこしたらすぐできますね！