【Excel/VBA】決定版！（今のところ）VLookUp的なVBA

配列を使ったり、クラスを使ったりしてVlookup的な動きをするVBAをここのことろ夢中になって作っていました。

【Excel/VBA】配列を使ってVLookupみたいなデータ流し込み

【Excel/VBA】クラスを使ってデータの流し込み

だーっと流し込みをするにはVlookアップを使えばいいわけで、実際VBAでやりたいシーンは①定期的にデータ流し込みをする　②流し込みした箇所が連続していなかったりする　場合が多いので、ツールっぽいものにしてみました。

例によって、自己満足・・・(^_-)-☆　そしてどうしてもクラスを使いたがり。。。

決定版とは自分の中で使えるかも～の決定版で、世間一般的なものを指しておりませんのであしからず・・・

◆コマンドシート：どのシートをどのシートへ、キー列はどこで、この列をあの列へ転記、という基礎部分を見える化しつつ、ここから転記用基礎データを取得します。

シート名：転記元・転記先のシート名を入力
開始行：転記元・転記先の各々の項目行を含まない開始行を入力
key値の列：転記元・転記先の各々のKey値がある列を入力

転記列（7行目以下）：転記元のこの列を、転記先のどの列に転記するか、を必要列数指定していく
※転記元の列指定はKey列から数えて何列目かを指定する（Vlookup関数と同じ感じ）

◆出力シート（転記先シート）とデータシート（転記元シート）

黄色列：Key値＝企業№　
出力シート緑のセルにデータシートのデータを転記する

◆◆◆◆◆コード◆◆◆◆◆

だいたいの流れ
①コマンドボタンでクラスのメインメソッド起動
②コマンドシートの基礎データ取得
③元データ配列に代入
④ ③の配列のkey値と配列内対応行をディクショナリに登録
⑤出力先シートに出力
　出力先シート最初の行から最後の行まで
　key値取得
　ディクショナリからkey値に対応する配列データ行取得
　対応する配列の行データを転記列に転記
※出力シートの「小計」や空白行などは対応するkey値がない→無視して次の行へ
※再計算をしない設定にしています（※１の３行）
　大きいデータを扱わない場合はこの部分はなくてもよいです。

〇コマンドシートのボタンのコード（クラス起動）　①に対応する部分

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual　　※１　　　

    ‘クラスcTenkiを使えるようにする
    Dim c As cTenki
    Set c = New cTenki
    ‘クラスcTenkiのtenkisutartメソッド起動
    c.tenkiStart

    Application.Calculate　　　　　　　　　　　　　　※１
    Application.Calculation = xlCalculationAutomatic　　※１
    Application.ScreenUpdating = True

    MsgBox “処理終了”

End Sub

〇クラスｃTenkino　コード

■■■■■　変数　■■■■■

‘元データ用変数
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

■■■■■　メインメソッド　■■■■■

Sub tenkiStart()
    Me.getdataKihon         ‘コマンドシートに入力してある基礎データ取得
    vData = Me.getdataMOTO ‘配列vDataに元データシートのデータを代入
    Set dic = Me.getdic     ‘配列vDataの1列目をディクショナリのkeyに登録,itemに対応行
    Me.outputData           ‘出力先シートに出力
    Set dic = Nothing              ‘ディクショナリの破棄
End Sub

■■■■■　部品メソッド　■■■■■

＊＊＊コマンドシートに入力してある基礎データ取得＊＊＊　②に対応する部分

Sub getdataKihon()
‘コマンドシートのボタンからマクロを起動するためアクティブシート=コマンドシート
    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

＊＊配列vDataに元データシートのデータを代入(Function)＊＊　③に対応する部分

Function getdataMOTO() As Variant
   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ディクショナリ登録(Function)＊＊＊　④に対応する部分

配列vDataの1列目をディクショナリのkeyに登録
配列のvDataの何行目にあるかをディクショナリのitemに登録
keyが重複した場合は最初のkeyのみが登録され２回目以降出現のkeyは登録されない

Function getdic() As Dictionary
    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      ‘一時使用ディクショナリの破棄

End Function

＊＊＊出力先シートに出力＊＊＊　⑤に対応する部分

Sub outputData()
    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値列を転記元・転記先とも「２」とし、データ元転記列指定は取引先名から数えて何列目かを指定するので、転記元は1列ずつ小さい値を指定します。（上記サンプルのエクセルの場合）