-1

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

下面是与当前工作表相邻的工作表，其中包含 Owner、Ticket 和 Comments 字段。我需要将这些字段复制到当前工作表中相应的应用程序名称和对象（连接为唯一 ID）。

在此处输入图像描述

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

在此处输入图像描述

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

=IF(INDIRECT(NextSheetName()&"!A3")&INDIRECT(NextSheetName()&"!B3") = A3&B3, INDIRECT(NextSheetName()&"!D3"), "0")

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

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

4

1 回答 1

1

如果您想使用 VBA 执行此操作，请尝试以下操作。代码将匹配的行从源工作表复制到目标工作表，并将源上的匹配行记录到目标，以防您发现这很有用。我将工作表命名为“源”和“目标”，并假设您想要匹配 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 后，您的引用将如下所示：

参考 Microsoft 脚本运行时

于 2012-08-10T03:44:12.230 回答