VBAのDictionaryオブジェクトの質問

Question

Dictionaryオブジェクトを使って割り付けをしています。
２つのシートがあります。
『抽出結果』シートと『条件』シートです。
『条件』シートのA列、B列、c～複数列にデータが入っています。
（複数行は都度変わります。）
『抽出結果』シートのA列、B列にデータが入っています。

やりたいことは、
『抽出結果』シートのA列とB列のデータと『条件』シートのA列とB列のデータが一致したら
『条件』シートのC列以降の複数列データを『抽出結果』シートのC列に記載する。
データの列数は各行によって様々です。0～200程度

このサイトで教えてもらったコードを変更して作成しようと考えているのですが、さっぱり分かりません。
すいませんが、教えて頂きたいです。

Public Sub dic_04_4()

    Dim mydic As Object
    Dim i As Long
    Dim ary1()
    Dim ary2() '動的配列として宣言
    Dim maxrow As Long
    Dim maxclm As Long

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set mydic = CreateObject("Scripting.Dictionary")

    With Sheets("条件")
        maxrow = .Cells(Rows.Count, 1).End(xlUp).Row
        ary1 = .Range(.Cells(2, 1), .Cells(maxrow, 3)).Value
        For i = UBound(ary1) To LBound(ary1) Step -1
            mydic(ary1(i, 1) & "," & ary1(i, 2)) = ary1(i, 3)
        Next i
    End With

    With Sheets("抽出結果")
        maxrow = .Cells(Rows.Count, 1).End(xlUp).Row
        ReDim ary2(2 To maxrow, 0) '動的配列のサイズを宣言
        Erase ary1 '配列の初期化
        ary1 = .Range(.Cells(2, 1), .Cells(maxrow, 2)).Value
        For i = LBound(ary1) To UBound(ary1)
            ary2(i + 1, 0) = mydic.Item(ary1(i, 1) & "," & ary1(i, 2))
        Next
        .Range(.Cells(2, 3), .Cells(maxrow, 3)).Value = ary2
    End With

    Set mydic = Nothing
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub

具体的にわからないことは
上記の
mydic(ary1(i, 1) & "," & ary1(i, 2)) = ary1(i, 3)
ary1(i, 3)が複数列になった場合のコードの書き方
です。

すいません。初心者なので諸々ご容赦ください。

Comments

[退会済みユーザー]

さっぱりわかりません、ですか。どこまでわかって、解決するのに何が必要だと感じていますか？

[coco_bauer]

コードを教えてくれた人は事情が判ったのでしょうから、その方に問い合わせるのが良いと思います。　teratailで不特定多数の方に問いかけるべきではないでしょう。

Answer 1

『条件』シートのC列以降の複数列データを『抽出結果』シートのC列に記載する。

複数列データを、C列にまとめて記載するということでしょうか。
それとも複数列のままコピーするということでしょうか。

とりあえず後者の場合、下記のコードでできました。
コピーする列数は最大の200列にしてます。
Dictionaryの Item にRangeを配列として格納してます。
ただ、件数が多いとそれなりに時間がかかりそうです。

Public Sub dic_04_4()
    Dim myDic As Object
    Dim i As Long, j As Long
    Dim ary1()
    Dim ary2()
    Dim maxrow As Long

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set myDic = CreateObject("Scripting.Dictionary")

    With Sheets("条件")
        maxrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        ary1 = .Range(.Cells(2, 1), .Cells(maxrow, 2)).Value
        For i = LBound(ary1) To UBound(ary1)
            myDic.Item(ary1(i, 1) & "," & ary1(i, 2)) = .Range(.Cells(i + 1, 3), .Cells(i + 1, 202)).Value
        Next i
    End With
    With Sheets("抽出結果")
        maxrow = .Cells(.Rows.Count, 1).End(xlUp).Row

        Erase ary1    '配列の初期化
        ary1 = .Range(.Cells(2, 1), .Cells(maxrow, 2)).Value
        For i = LBound(ary1) To UBound(ary1)
            .Range(.Cells(i + 1, 3), .Cells(i + 1, 202)).Value = myDic(ary1(i, 1) & "," & ary1(i, 2))
        Next
    End With

    Set myDic = Nothing

    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Comments

[cd987456]

回答ありがとうございます。
教えていただいた内容で問題なくできました。
mydic(ary1(i, 1) & "," & ary1(i, 2)) = ary1(i, 3)
　　　　⇓
myDic.Item(ary1(i, 1) & "," & ary1(i, 2)) = .Range(.Cells(i + 1, 3), .Cells(i + 1, 202)).Value
変えることで複数列になるんですね。
勉強になりました。
ありがとうございます。