Question

我有2个电子表格：

main.xlsxm

enter image description here

drs.xlsx

enter image description here

目前：

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

如果找到第二个匹配（前提是它与第一个不匹配）   匹配）：其中drs.xlsx中的列值E等于列值A.   main.xlsx将drs.xls中的列值B复制到列值K in   main.xlsx

如果找到第三个匹配（前提是它与第一个不匹配）   和第二个匹配）：其中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列，找到每个匹配项（忽略任何进一步的匹配，只有特定用户的第一个主机），以便列没有被覆盖），我该怎么做呢？

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，那么它是第一次找到匹配，因此复制到A列

如果存在匹配但忽略后续匹配，则复制额外的列行

2 个答案: