查找相邻工作表中的单元格并将其复制到当前工作表

Question

我需要创建一个宏（或函数），以便将相邻工作表中的单元格复制到当前工作表中（如果它们符合某些条件）。

以下是与当前工作表相邻的工作表，其中包含“所有者”，“故障单”和“注释”字段。我需要将这些字段复制到当前工作表中相应的应用程序名称和对象（连接为唯一ID）。

以下是我需要将上述字段复制到的当前工作表。请注意，应用程序未按相同顺序列出。这将是这种情况，因为我永远不知道数据将在哪个顺序，或者相同的数据是否甚至在新工作表中。

到目前为止，我已尝试过这个功能：

= IF（INDIRECT（NextSheetName（）＆amp;“！A3”）＆amp; INDIRECT（NextSheetName（）＆amp;“！B3”）= A3＆amp; B3，INDIRECT（NextSheetName（）＆amp;“！D3”）， “0”）

仅在工作表具有相同顺序的相同数据的情况下才有效。

有谁知道如何做到这一点？

Answer 1

如果要使用VBA执行此操作，请尝试以下操作。代码将源工作表中的匹配行复制到目标工作表，并将源上的匹配行记录到目标，以防您发现有用。我将我的工作表命名为“Source”和“Target”，并假设您希望匹配A列和B列的串联。

源和目标中的行数无关紧要，匹配的显示顺序也不重要。

我写了两个不同的版本。第一个工作，但我并不疯狂，因为它遍历源范围寻找目标中每个值的匹配。第二个版本使用一次构建的字典。然后匹配搜索项而不必遍历范围。请注意，要使用字典，您需要引用Microsoft Scripting Runtime。

第一版:(功能齐全，但需要多个循环）

Sub GetTwoColumnMatches()

    Dim wsrc As Worksheet
    Dim wTgt As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim lLastTargetRow As Long
    Dim lMatchedRow As Long
    Dim sConcat As String

    Set wsrc = Sheets("Source")
    Set wTgt = Sheets("Target")
    lLastTargetRow = wTgt.Range("A" & wTgt.Rows.Count).End(xlUp).Row


    Set rng = wTgt.Range("a2:a" & lLastTargetRow)
    For Each cell In rng
        sConcat = cell & cell.Offset(, 1)
        lMatchedRow = Matches(sConcat)
        If lMatchedRow <> 0 Then
            wTgt.Range("a" & cell.Row & ":e" & cell.Row).Value = _
            wsrc.Range("a" & lMatchedRow & ":e" & lMatchedRow).Value
            wTgt.Range("f" & cell.Row) = lMatchedRow
        End If
    Next
End Sub

Function Matches(SearchFor As String) As Long
    Dim wsrc As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim lLastSourceRow As Long
    Dim lSourceRow As Long

    Set wsrc = Sheets("Source")
    lLastSourceRow = wsrc.Range("a" & wsrc.Rows.Count).End(xlUp).Row

    Set rng = wsrc.Range("a2:a" & lLastSourceRow)
    Matches = 0
    For Each cell In rng
        If cell & cell.Offset(, 1) = SearchFor Then
            Matches = cell.Row
            Exit For
        End If
    Next
End Function

第二版:(已优化，需要参考Microsoft Scripting Runtime）

Sub GetTwoColumnMatches()

    Dim wsrc As Worksheet
    Dim wTgt As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim srcRng As Range
    Dim srcCell As Range

    Dim lLastTargetRow As Long
    Dim lLastSourceRow As Long
    Dim lMatchedRow As Long
    Dim lSourceRow As Long

    Dim sConcat As String
    Dim dict As Dictionary

    Set wsrc = Sheets("Source")
    Set wTgt = Sheets("Target")
    lLastTargetRow = wTgt.Range("A" & wTgt.Rows.Count).End(xlUp).Row

    Set wsrc = Sheets("Source")
    lLastSourceRow = wsrc.Range("a" & wsrc.Rows.Count).End(xlUp).Row

    'Create the dictionary
    Set dict = New Dictionary

    Set srcRng = wsrc.Range("a2:b" & lLastSourceRow)
    For Each srcCell In srcRng
        sConcat = srcCell & srcCell.Offset(, 1)
        If Len(sConcat) > 0 Then dict.Add sConcat, srcCell.Row
    Next

    Set rng = wTgt.Range("a2:a" & lLastTargetRow)
    For Each cell In rng
        sConcat = cell & cell.Offset(, 1)
        lMatchedRow = dict.Item(sConcat)
        If lMatchedRow <> 0 Then
            wTgt.Range("a" & cell.Row & ":e" & cell.Row).Value = _
            wsrc.Range("a" & lMatchedRow & ":e" & lMatchedRow).Value
            wTgt.Range("f" & cell.Row) = lMatchedRow
        End If
    Next
End Sub

一旦您正确选择了Microsoft Scripting Runtime，以下是您的参考文献的内容：