Excel VBA異なる列に複数の一致をインポートする同じ行

Question

別のwbからセルをインポートしようとしています。したがって、wb1 col Hのセルがwb2 col Kのセルと一致する場合、wb1 col kとL = wb2 col CとEが一致する行にあります。今度はいくつかの一致があるので、次の列にオフセットしたいと思っています。 mとnは次の集合、oとpは次の集合などである。これは動作しません

Private Sub CommandButton1_Click() 

Dim rcell As Range, sValue As String 
Dim lcol As Long, cRow As Long 
Dim dRange As Range, sCell As Range 
Dim LastRow As Integer 
Dim CurrentRow As Integer 


Set ws1 = ThisWorkbook 
Set ws2 = Workbooks("Workbook2").Worksheets("Sheet1") 
Sheet1LastRow = ThisWorkbook.Sheets("Data").Range("H2:H50000").Value 'Search criteria column 
Sheet2LastRow = Workbooks("Workbook2").Worksheets("Sheet1").Range("Q" & Rows.Count).End(xlUp).Row 'Where to look for matches 

With Workbooks("Workbook2").Worksheets("Sheet1") 
    For j = 1 To Sheet1LastRow 
     For i = 1 To Sheet2LastRow   
      If ThisWorkbook.Sheets("Data").Range("H").Value = ws2.Cells(i, 11).Value Then 
       ws2.Cells(i, 11).Value = ThisWorkbook.Sheets("Data").Range("C").Value 
       ws2.Cells(i, 12).Value = ThisWorkbook.Sheets("Data").Range("E").Value 
      End If 
      If InStr(1, ws2.Cells.Value, ws1.Cells.Value) And  Trim(ws1.Cells.Value) <> "" Then 
       rcell.Offset(0, lcol).Value = ws2.Cells.Offset(0, 2).Value 
       lcol = lcol + 1 
      End If 
     Next i 
    Next j 
End With 

End Sub 

：

は、これは私がこれまで持っているものです。私は何が欠けているのか分からないので、基本的に諦めました。

私はこのようなものを探しましたが、VlookupまたはMatchのようなものしか見つけられませんでした。

Answer 1

各マッチをコピーした後に2つずつシフトするオフセットを記録することで、これを実行できます。私はこれをoffsという変数で追跡します。 また、コード内で "疑わしい"ものではなく、テキストで説明されているように、コピーが012bからwb1からになるとします。

Private Sub CommandButton1_Click() 
    Dim cel1 As Range, cel2 As Range 
    For Each cel1 In ThisWorkbook.Sheets("Data").UsedRange.Columns("H").Cells 
     Dim offs As Long: offs = 3 ' <-- Initial offset, will increase by 2 after each match 
     For Each cel2 In Workbooks("Workbook2").Worksheets("Sheet1").UsedRange.Columns("K").Cells 
      If cel1.Value = cel2.Value Then 
       cel1.offset(, offs).Value = cel2.offset(, -8).Value ' <- wb2(C) to wb1(K) 
       cel1.offset(, offs + 1).Value = cel2.offset(, -6).Value ' <- wb2(E) to wb1(L) 
       offs = offs + 2 ' <-- now shift the destination column by 2 for next match 
      End If 
     Next 
    Next 
End Sub