匹配2列超过2张,然后复制整个行

一个显示数据如何排列的例子。

一个显示数据如何排列的例子。

我有2个电子表格。 一个很大,没有更新,一个是较小的更新的信息。 我正在尝试用较小的信息更新较大的信息。 两张表都有相同列中的数据(项目号和供应商ID)。

我试图匹配项目#的第一个,因为有更less的重复。 我使用Match来返回第一张表中匹配项目#的行索引,然后检查供应商ID是否匹配。 如果是的话,我把它复制到第一张纸上。 如果不是的话,我试图让比赛通过一个新的范围来find下一场比赛。 我做了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 

我知道我应该做一个循环,但不能想到如何设置它。

我build议使用Range.Find与.FindNext结合来为Item ID创build一个Find循环,然后您可以使用它来validation供应商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 
 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