[英]Match 2 columns over 2 sheets then copy entire row
An example showing how the data is arranged. 显示数据排列方式的示例。
I have 2 spreadsheets. 我有2个电子表格。 One is large and not updated and one is small with more recent information.
一种是大型且未更新,另一种是小型,具有更多最新信息。 I am trying to update the larger one with information from the smaller one.
我正在尝试使用较小的信息来更新较大的信息。 Both sheets have data in the same columns (item # and supplier ID).
这两张纸的数据都在同一列中(项目编号和供应商ID)。
I am trying to match item #'s first because there are less duplicates. 我尝试匹配第一个项目,因为重复项较少。 I used Match to return the row index of the matched item # in the first sheet, then checked whether the Supplier ID matched.
我使用Match返回第一张表中匹配项#的行索引,然后检查Supplier ID是否匹配。 If it does, I copy it to the first sheet.
如果有,我将其复制到第一张纸上。 If not, I'm trying to get Match to find the next match by making a new range.
如果没有,我试图通过创建一个新的范围来让Match找到下一个比赛。 I did this 3 times to try to get around duplicate Item IDs.
我这样做了3次,以避开重复的商品ID。
My code runs but I can't get it to transfer anything. 我的代码可以运行,但是我无法传输任何内容。
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
I know I should be doing this with a loop but can't think of how to set it up. 我知道我应该使用循环来执行此操作,但无法考虑如何设置它。
I recommend using Range.Find combined with .FindNext to create a Find loop for the Item ID, which you can then use to verify if the Supplier ID also matches. 我建议结合使用Range.Find和.FindNext来创建商品ID的查找循环,然后可以使用该循环来验证供应商ID是否也匹配。 Given the information provided in your example image and in your code, something like this should work for you:
给定示例图像和代码中提供的信息,类似以下内容应适用于您:
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.