sheet1のA列〜E列の列データに一致する sheet2のA列〜E列のデータがあった場合 sheet1のL列〜AC列の列データを sheet2のL列〜AC列に抽出する。これを最終行まで行う。というマクロを組みたいです。
sheet1のA列〜E列の列データに一致する sheet2のA列〜E列のデータがあった場合 sheet1のL列〜AC列の列データを sheet2のL列〜AC列に抽出する。これを最終行まで行う。というマクロを組みたいです。 コマンドボタンによる。マクロ開始。 写真の赤字は行番号、列番号
補足
sheet2の行の順番はバラバラです。 あくまで列データが一緒のものに対して sheet2ではL列〜AC列に sheet1のL列〜AC列のデータが入力されるということです。
Excel | Visual Basic・68閲覧
ベストアンサー
Sheet2のデータの始まりは2行目としました。 一例です。 Sub test() Dim dic As Object Dim sh1 As Worksheet, sh2 As Worksheet Dim r As Long, rmax As Long Dim dkey As Variant Application.ScreenUpdating = False Set dic = CreateObject("Scripting.Dictionary") Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet2") With sh1 For r = 7 To .Cells(Rows.Count, 1).End(xlUp).Row 'キー生成 dkey = .Cells(r, 1).Value & "-" & .Cells(r, 2).Value & "-" & _ .Cells(r, 3).Value & "-" & .Cells(r, 4).Value & "-" & .Cells(r, 5).Value If dic.Exists(dkey) = False Then dic.Add dkey, r End If Next r End With With sh2 For r = 2 To .Cells(Rows.Count, 1).End(xlUp).Row dkey = .Cells(r, 1).Value & "-" & .Cells(r, 2).Value & "-" & _ .Cells(r, 3).Value & "-" & .Cells(r, 4).Value & "-" & .Cells(r, 5).Value If dic.Exists(dkey) Then .Cells(r, 12).Resize(, 18).Value = sh1.Cells(dic.Item(dkey), 12).Resize(, 18).Value End If Next r End With Set dic = Nothing Application.ScreenUpdating = True End Sub
質問者からのお礼コメント
いつもありがとうございます 解決しました！
お礼日時：2021/11/18 12:47
