在2張紙上匹配2列，然後複製整行

Question

顯示數據排列方式的示例。

我有2個電子表格。一個很大，沒有更新，一個很小，有更多的最新信息。我正試圖用較小的信息更新較大的信息。兩張表都有相同列中的數據（商品編號和供應商編號）。

我想匹配項目＃的第一個，因爲有更少的重複。我使用Match來返回第一張表中匹配項目＃的行索引，然後檢查供應商ID是否匹配。如果確實如此，我將它複製到第一張紙上。如果沒有，我試圖讓Match通過創建一個新的範圍來找到下一場比賽。我這樣做了3次，試圖解決重複的項目ID。

我的代碼運行但我不能讓它傳輸任何東西。

Sub UpdateSheet() 

    Dim i As Integer 

    Dim targetRow As Integer 
    Dim nextTargetRow As Integer 
    Dim lastTargetRow As Integer 

    Dim totalRows As Integer 
    Dim totalSearchRows As Integer 

    Dim searchRange As Range 
    Dim nextSearchRange As Range 
    Dim lastSearchRange As Range 

    totalRows = Sheet5.Cells(Sheet5.Rows.Count, 1).End(xlUp).Row 
    totalSearchRows = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row 

    'Sets search range to column in larger spreadsheet with Item # 
    Set searchRange = Sheet1.Range(Sheet1.Cells(2, 4), Sheet1.Cells(totalSearchRows, 4)) 

    'For each item # in new spreadsheet 
    For i = 2 To i = totalRows 
     'Finds first row in search range which matches item # 
     targetRow = Application.Match(Sheet5.Cells(i, 4), searchRange, 0) 
     'If supplier ID column values match, replace entire row in Sheet 1 with values from corresponding row in Sheet5 
     If Sheet5.Cells(i, 1).Value = Sheet1.Cells(targetRow, 1).Value Then 
      Sheet1.Cells(targetRow, 1).EntireRow.Value = Sheet5.Cells(i, 1).EntireRow.Value 
     'If supplier ID column values do not match, search for next item # match 
     Else: Set nextSearchRange = Sheet1.Range("D" & targetRow + 1, "D" & totalSearchRows) 
      nextTargetRow = Application.Match(Sheet5.Cells(i, 4), nextSearchRange, 0) 
      If Sheet5.Cells(i, 1).Value = Sheet1.Cells(nextTargetRow, 1).Value Then 
       Sheet1.Cells(nextTargetRow, 1).EntireRow.Value = Sheet5.Cells(i, 1).EntireRow.Value 
      Else: Set lastSearchRange = Sheet1.Range("D" & nextTargetRow + 1, "D" & totalSearchRows) 
       lastTargetRow = Application.Match(Sheet5.Cells(i, 4), lastSearchRange, 0) 
       If Sheet5.Cells(i, 1).Value = Sheet1.Cells(lastTargetRow, 1).Value Then 
        Sheet1.Cells(lastTargetRow, 1).EntireRow.Value = Sheet5.Cells(i, 1).EntireRow.Value 
       End If 
      End If 
     End If 

    Next 

End Sub 

我知道我應該這樣做的循環，但不能想到如何設置它。

Answer 1

我建議使用Range.Find與.FindNext結合爲項目ID創建一個查找循環，然後可以使用該查找循環來驗證供應商ID是否也匹配。鑑於您的示例圖像，並在你的代碼中提供的信息，這樣的事情應該爲你工作：

Sub UpdateSheets() 

    Dim wb As Workbook 
    Dim wsData As Worksheet 
    Dim wsNew As Worksheet 
    Dim rSearchCell As Range 
    Dim rFound As Range 
    Dim sFirst As String 
    Dim sMessage As String 
    Dim sNotFound As String 
    Dim lUpdateCounter As Long 
    Dim bUpdated As Boolean 

    Set wb = ActiveWorkbook 
    Set wsData = wb.Sheets(1) 
    Set wsNew = wb.Sheets(5) 

    'Item ID is column D, search for that first 
    For Each rSearchCell In wsNew.Range("D2", wsNew.Cells(wsNew.Rows.Count, "D").End(xlUp)).Cells 
     bUpdated = False 
     Set rFound = Nothing 
     Set rFound = wsData.Columns("D").Find(rSearchCell.Value, wsData.Cells(wsData.Rows.Count, "D"), xlValues, xlWhole) 
     If Not rFound Is Nothing Then 
      'Match was found for the Item ID, start a loop to match the Supplier ID in column A 
      sFirst = rFound.Address 
      Do 
       If LCase(wsData.Cells(rFound.Row, "A").Value) = LCase(wsNew.Cells(rSearchCell.Row, "A").Value) Then 
        'Found the matching supplier ID, update the Data sheet with the info from the New sheet 
        rFound.EntireRow.Value = rSearchCell.EntireRow.Value 
        lUpdateCounter = lUpdateCounter + 1 
        bUpdated = True 
        Exit Do 'Exit the Find loop and move to the next rSearchCell 
       End If 
       Set rFound = wsData.Columns("D").FindNext(rFound) 
      Loop While rFound.Address <> sFirst 
     End If 
     If bUpdated = False Then 
      sNotFound = sNotFound & Chr(10) & "Item ID: " & rSearchCell.Value & " // Supplier ID: " & wsNew.Cells(rSearchCell.Row, "A").Value 
     End If 
    Next rSearchCell 

    sMessage = "Update completed for " & lUpdateCounter & " rows of data." 
    If Len(sNotFound) > 0 Then 
     sMessage = sMessage & Chr(10) & _ 
        Chr(10) & _ 
        "Unable to find matches for the following rows:" & _ 
        sNotFound 
    End If 

    'Provide message to user indicating macro completed, and if there were any rows not found in wsData 
    MsgBox sMessage, , "Update Completed" 

End Sub 

Answer 2

Sub UpdateData() 
    Dim item As Range, items As Range, master As Range, search_item As String, cl As Range 

    Set items = Worksheets("Small").Range("D2:D" & Range("D1").End(xlDown).Row) 
    Set master = Worksheets("Large").Range("D2:D" & Range("D1").End(xlDown).Row) 

    For Each item In items 
     search_item = item 

     Set cl = master.Find(What:=search_item, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) 

     If Not cl Is Nothing Then 

      If cl.Offset(0, -3) = item.Offset(0, -3) Then 
       Range(Cells(item.Row, 8), Cells(item.Row, 11)).Copy Destination:=cl.Offset(0, 4) 
      Else 
       Do 
        Set cl = master.FindNext(After:=cl) 
        If cl.Offset(0, -3) = item.Offset(0, -3) Then 
         Range(Cells(item.Row, 8), Cells(item.Row, 11)).Copy Destination:=cl.Offset(0, 4) 
         Exit Do 
        End If 
       Loop 
      End If 
     End If 
    Next item 
End Sub