在2張紙上匹配2列，然后復制整行

Question

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

我有2個電子表格。 一種是大型且未更新，另一種是小型，具有更多最新信息。 我正在嘗試使用較小的信息來更新較大的信息。 這兩張紙的數據都在同一列中（項目編號和供應商ID）。

我嘗試匹配第一個項目，因為重復項較少。 我使用Match返回第一張表中匹配項＃的行索引，然后檢查Supplier 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