複製一個額外的列行對面如果有比賽，但忽略了像火柴

Question

以後我有2個電子表格：

main.xlsxm

drs.xlsx

此刻：

如果drs.xlsx列值E等於列值A在main.xlsx：在drs.xls在main.xlsx複印列值B中的匹配的行然後 到 列值J在main.xlsx

如果找到第二個匹配項（假設它與第一個匹配項 不相同）：drs.xlsx中的列值E等於 中的列值A main.xlsx將drs.xls中的列值B複製到列值K in main.xlsx

如果找到第三個匹配項（假設它與第一個 和第二個匹配項不相同）：Where列在drs.xlsx值E等於列 值A在main.xlsx複印列值B在drs.xls柱值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列，以查找找到的每個匹配（忽略任何進一步匹配，只有特定用戶的第一個主機）沒有被覆蓋），我會怎麼做呢？

Answer 1

只需添加代碼在do loop之前，你' Remember address of first match。

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

Answer 2

難道是直線前進的k = k +1後加入以下：

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

若k = 1，那麼這是它第一次找到匹配的這麼過欄複製一個