配列を使ったり、クラスを使ったりしてVlookup的な動きをするVBAをここのことろ夢中になって作っていました。
【Excel/VBA】配列を使ってVLookupみたいなデータ流し込み
だーっと流し込みをするにはVlookアップを使えばいいわけで、実際VBAでやりたいシーンは①定期的にデータ流し込みをする ②流し込みした箇所が連続していなかったりする 場合が多いので、ツールっぽいものにしてみました。
例によって、自己満足・・・(^_-)-☆ そしてどうしてもクラスを使いたがり。。。
決定版とは自分の中で使えるかも~の決定版で、世間一般的なものを指しておりませんのであしからず・・・
◆コマンドシート:どのシートをどのシートへ、キー列はどこで、この列をあの列へ転記、という基礎部分を見える化しつつ、ここから転記用基礎データを取得します。
シート名:転記元・転記先のシート名を入力
開始行:転記元・転記先の各々の項目行を含まない開始行を入力
key値の列:転記元・転記先の各々のKey値がある列を入力
転記列(7行目以下):転記元のこの列を、転記先のどの列に転記するか、を必要列数指定していく
※転記元の列指定はKey列から数えて何列目かを指定する(Vlookup関数と同じ感じ)
◆出力シート(転記先シート)とデータシート(転記元シート)
黄色列:Key値=企業№
出力シート緑のセルにデータシートのデータを転記する
◆◆◆◆◆コード◆◆◆◆◆
だいたいの流れ
①コマンドボタンでクラスのメインメソッド起動
②コマンドシートの基礎データ取得
③元データ配列に代入
④ ③の配列のkey値と配列内対応行をディクショナリに登録
⑤出力先シートに出力
出力先シート最初の行から最後の行まで
key値取得
ディクショナリからkey値に対応する配列データ行取得
対応する配列の行データを転記列に転記
※出力シートの「小計」や空白行などは対応するkey値がない→無視して次の行へ
※再計算をしない設定にしています(※1の3行)
大きいデータを扱わない場合はこの部分はなくてもよいです。
〇コマンドシートのボタンのコード(クラス起動) ①に対応する部分
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual ※1
‘クラスcTenkiを使えるようにする
Dim c As cTenki
Set c = New cTenki
‘クラスcTenkiのtenkisutartメソッド起動
c.tenkiStart
Application.Calculate ※1
Application.Calculation = xlCalculationAutomatic ※1
Application.ScreenUpdating = True
MsgBox “処理終了”
Private wsMoto As Worksheet ‘元データシート
Private rowStrMoto As Long ‘データ開始行(項目行は含まない)
Private colKeyMoto As Long ‘key値ののある列(データ範囲の一番左であること)
Private arColMoto() As Long ‘転記元列を格納する配列
Private wsSaki As Worksheet ‘元データシート
Private rowStrSaki As Long ‘出力開始行
Private colKeySaki As Long ‘key値ののある列
Private arColSaki() As Long ‘転記元列に対応する出力列を格納する配列
Private vData As Variant
‘元データkey値と対応行登録ディクショナリ
Private dic As Dictionary
■■■■■ メインメソッド ■■■■■
Me.getdataKihon ‘コマンドシートに入力してある基礎データ取得
vData = Me.getdataMOTO ‘配列vDataに元データシートのデータを代入
Set dic = Me.getdic ‘配列vDataの1列目をディクショナリのkeyに登録,itemに対応行
Me.outputData ‘出力先シートに出力
Set dic = Nothing ‘ディクショナリの破棄
End Sub
‘コマンドシートのボタンからマクロを起動するためアクティブシート=コマンドシート
With ActiveSheet
‘***ワークシートセット***
Set wsMoto = Worksheets(.Range(“B2”).Value) ‘元データワークシート
Set wsSaki = Worksheets(.Range(“C2”).Value) ‘出力先ワークシート
rowStrMoto = .Range(“B3”).Value ‘データ開始行(項目行は含まない)
rowStrSaki = .Range(“C3”).Value ‘出力開始行
‘***Key列をセット***
colKeyMoto = .Range(“B4”).Value ‘元データkey列
colKeySaki = .Range(“C4”).Value ‘出力先key列
‘***列をセット***
Dim rowStr As Long, rowEnd As Long
rowStr = 7 ‘転記列開始行
rowEnd = .Cells(.Rows.Count, 2).End(xlUp).row ‘転記列最終行(B列で判定)
ReDim arColMoto(1 To rowEnd – rowStr + 1)
ReDim arColSaki(1 To rowEnd – rowStr + 1)
Dim r As Long, idx As Long
idx = 1
For r = rowStr To rowEnd ‘7行目から数字入力のある最後の行まで
arColMoto(idx) = .Cells(r, 2).Value ‘arColMotoに元データの列をセット
arColSaki(idx) = .Cells(r, 3).Value ‘arColSakiに出力先の列をセット
idx = idx + 1
Next r
End With
End Sub
With wsMoto ‘元データシート
Dim rowEnd As Long ‘元データシート最終行取得
rowEnd = .Cells(.Rows.Count, colKeyMoto).End(xlUp).row
Dim colEnd As Long ‘配列の最大値=必要な最大列
colEnd = WorksheetFunction.Max(arColMoto) + colKeyMoto – 1
‘配列vDataに元データシートのデータを代入
‘セル範囲:データ開始行・key列から、最終行・最終列まで
getdataMOTO = .Range(.Cells(rowStrMoto, colKeyMoto), .Cells(rowEnd, colEnd)).Value
End With
End Function
配列のvDataの何行目にあるかをディクショナリのitemに登録
keyが重複した場合は最初のkeyのみが登録され2回目以降出現のkeyは登録されない
Dim dic_ As Dictionary, idx As Long, vKey As String
Set dic_ = New Dictionary
For idx = LBound(vData, 1) To UBound(vData, 1)
vKey = vData(idx, 1)
If Not dic_.Exists(vKey) Then
dic_.Add vKey, idx
End If
Next idx
Set getdic = dic_
Set dic_ = Nothing ‘一時使用ディクショナリの破棄
Dim sKey As String ’key値受取用
Dim rowEnd As Long ’出力シート最終行
Dim cnt As Long ’列配列カウント
Dim r As Long, c As Long ’出力行・列
Dim idx As Long, colidx As Long ‘配列行・列
With wsSaki
rowEnd = .Cells(.Rows.Count, colKeySaki).End(xlUp).row
For r = rowStrSaki To rowEnd ‘出力先シート開始行から最終行まで
sKey = .Cells(r, colKeySaki).Value ‘出力先シートKey列の値をsKeyに代入
‘出力先key値が配列key登録あれば
If dic.Exists(sKey) Then
idx = dic(sKey) ‘配列の該当行をdicから取得
For cnt = LBound(arColMoto) To UBound(arColMoto)
c = arColSaki(cnt) ‘出力列
colidx = arColMoto(cnt) ‘配列の対応列
.Cells(r, c).Value = vData(idx, colidx) ‘セルに出力
Next cnt
End If
‘出力先key値が配列key登録なければなにもしない。出力シート次の行へ
Next r
End With
End Sub
B列の取引先名をkey値にする場合は、key値列を転記元・転記先とも「2」とし、データ元転記列指定は取引先名から数えて何列目かを指定するので、転記元は1列ずつ小さい値を指定します。(上記サンプルのエクセルの場合)
コメント