如果存在匹配，则复制多余的行列，但忽略后续的类似匹配

我有2个电子表格：

main.xlsxm

drs.xlsx

在这一刻：

如果drs.xlsx中的列值E等于main.xlsx中的列值A：则在main.xlsx中的匹配行上将drs.xls中的列值B复制到main.xlsx中的列值J

如果find第二个匹配项（只要它与第一个匹配项不相同）：drs.xlsx中的列值E等于main.xlsx中的列值A将drs.xls中的列值B复制到main中的列值K. XLSX

如果find了第三个匹配项（假设它与第一个和第二个匹配项不相同）：drs.xlsx中的列值E等于main.xlsx中的列值A将drs.xls中的列值B复制到列值L中main.xlsx

这由以下代码处理：

Sub drs_Update() Dim wb As Workbook Dim sh1 As Worksheet Dim sh2 As Worksheet Dim user As Range Dim lastrowdrs As Long, lastrowMAIN As Long Dim rng As Range, res As Range Dim k As Byte Dim fAddr As String Application.ScreenUpdating = False ' Specify sheet name for Main wb Set sh1 = ThisWorkbook.Worksheets("Master") ' Open drs Set wb = Workbooks.Open("C:\Working\drs.xlsx") ' Specify sheet name for drs wb Set sh2 = wb.Worksheets("Sheet1") With sh1 ' Find last row on column A in the Main wb lastrowMAIN = .Cells(.Rows.Count, "A").End(xlUp).Row ' Clear previous data in columns J:L '.Range("J1:L" & lastrowMAIN).ClearContents End With With sh2 .AutoFilterMode = False ' Find last row on column A in drs wb lastrowdrs = .Cells(.Rows.Count, "A").End(xlUp).Row ' Apply filter With .Range("A1:D1") .AutoFilter Field:=1, Criteria1:=Array("TW", "W", "L", "V"), Operator:=xlFilterValues .AutoFilter Field:=3, Criteria1:="Microsoft Windows 7 Enterprise", Operator:=xlOr, Criteria2:="Microsoft Windows XP Professional" .AutoFilter Field:=3, Criteria1:="Windows 7", Operator:=xlOr, Criteria2:="Windows XP" .AutoFilter Field:=4, Criteria1:="Workstation-Windows" End With On Error Resume Next ' Get only visible rows in column E Set rng = .Range("E1:E" & lastrowdrs).SpecialCells(xlCellTypeVisible) On Error GoTo 0 ' Loop through every user in Main wb For Each user In sh1.Range("A1:A" & lastrowMAIN) ' Counter for finding entries k = 0 ' Find first match Set res = rng.Find(What:=user.Value, MatchCase:=False) If Not res Is Nothing Then ' Remember address of first match fAddr = res.Address Do ' User.Offset(,9 + k) gives you column J for k=0, K for k=1, L for k=2 user.Offset(, 9 + k).Value = res.Offset(, -3).Value ' Increment k k = k + 1 ' Find next match Set res = rng.FindNext(res) ' If nothing found, exit, stop searching entries for current user If res Is Nothing Then Exit Do ' If we already found 3 matches, then stop searching for current user Loop While fAddr <> res.Address And k < 3 ' Update column headers sh1.Cells(1, 10).Value = "Hostname1" sh1.Cells(1, 11).Value = "Hostname2" sh1.Cells(1, 12).Value = "Hostname3" End If Next user End With End Sub 

现在，如果我想将drs.xlsx上的列A中的任何内容复制到main.xlsm上的R列，以查找find的每个匹配（忽略任何进一步的匹配，只有特定用户的第一个主机），以便不会覆盖该列），我怎么去做呢？

Answer 1

只要在do loop之前添加代码，在那里你可以' Remember address of first match 。

 user.Offset(0, 17).Value = res.Offset(0, -4).Value 

Answer 2

在k = k +1之后join下面的代码是否会如此简单：

 If k = 1 Then user.Offset(,17).Value = res.Offset(, -4).Value End If 

如果k = 1，那么它是第一次find匹配，所以复制到列A上