Fatal编程技术网
  • function/
  • Function 查找相邻工作表中的单元格并将其复制到当前工作表中

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

function excel vba

Function 查找相邻工作表中的单元格并将其复制到当前工作表中,function,excel,vba,Function,Excel,Vba,我需要创建一个宏（或函数），将相邻工作表中的单元格复制到当前工作表中（如果它们满足某些条件） 下面是与当前工作表相邻的工作表，其中包含所有者、票证和注释字段。我需要将这些字段复制到当前工作表中相应的应用程序名称和对象（连接为唯一ID） 下面是我需要将上述字段复制到的当前工作表。请注意，这些应用程序不是按相同的顺序列出的。这将是一种情况，因为我永远不知道数据的顺序，或者相同的数据是否会出现在新的工作表中 到目前为止，我已经尝试了此功能： =如果（间接（NextSheetName（）&“！A3”

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

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

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

到目前为止，我已经尝试了此功能：

=如果（间接（NextSheetName（）&“！A3”）&间接（NextSheetName（）&“！B3”）=A3&B3，间接（NextSheetName（）&“！D3”），“0”）

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

有人知道如何做到这一点吗？

如果您想使用VBA实现这一点，请尝试以下方法。代码将匹配行从源工作表复制到目标工作表，并将源工作表中的匹配行记录到目标工作表中，以防您发现这很有用。我将我的工作表命名为“Source”和“Target”，并假设您希望在A列和B列的连接上进行匹配

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

我写了两个不同的版本。第一种方法很有效，但我对它不感兴趣，因为它在源范围内循环，为目标中的每个值寻找匹配项。第二个版本使用一次构建的字典。然后匹配搜索词，而不必在一个范围内循环。请注意，要使用字典，您需要对Microsoft脚本运行时的引用

第一版：（功能性，但需要多个循环）

Sub-GetTwoColumnMatches（）
将wsrc设置为工作表
将wTgt设置为工作表
变暗rng As范围
暗淡单元格作为范围
暗淡的lLastTargetRow与长
暗淡的，暗淡的
作为字符串的Dim sConcat
设置wsrc=图纸（“源”）
设置wTgt=图纸（“目标”）
lLastTargetRow=wTgt.Range（“A”&wTgt.Rows.Count）.End（xlUp）.Row
设置rng=wTgt.范围（“a2:a”和lLastTargetRow）
对于rng中的每个单元
sConcat=单元和单元偏移量（，1）
lMatchedRow=匹配项（sConcat）
如果lMatchedRow 0，则
wTgt.Range（“a”&cell.Row&“：e”&cell.Row）。值=_
wsrc.Range（“a”&lMatchedRow&“：e”&lMatchedRow）.Value
wTgt.范围（“f”和单元格行）=lMatchedRow
如果结束
下一个
端接头
函数匹配（搜索为字符串）的长度
将wsrc设置为工作表
变暗rng As范围
暗淡单元格作为范围
Dim LLASTSOURCE行的长度为
昏暗的长流
设置wsrc=图纸（“源”）
lLastSourceRow=wsrc.Range（“a”&wsrc.Rows.Count）.End（xlUp）.Row
设置rng=wsrc.Range（“a2:a”和lLastSourceRow）
匹配项=0
对于rng中的每个单元
如果单元格和单元格偏移量（，1）=搜索
匹配=单元格。行
退出
如果结束
下一个
端函数
第二版：（已优化，需要参考Microsoft脚本运行时）

Sub-GetTwoColumnMatches（）
将wsrc设置为工作表
将wTgt设置为工作表
变暗rng As范围
暗淡单元格作为范围
变光srcRng As范围
作为范围的单元格
暗淡的lLastTargetRow与长
Dim LLASTSOURCE行的长度为
暗淡的，暗淡的
昏暗的长流
作为字符串的Dim sConcat
字典
设置wsrc=图纸（“源”）
设置wTgt=图纸（“目标”）
lLastTargetRow=wTgt.Range（“A”&wTgt.Rows.Count）.End（xlUp）.Row
设置wsrc=图纸（“源”）
lLastSourceRow=wsrc.Range（“a”&wsrc.Rows.Count）.End（xlUp）.Row
'创建字典
Set dict=新字典
设置srcRng=wsrc.Range（“a2:b”和lLastSourceRow）
对于srcRng中的每个srcCell
sConcat=srcCell&srcCell.Offset（，1）
如果Len（sConcat）>0，则dict.Add sConcat，srcCell.Row
下一个
设置rng=wTgt.范围（“a2:a”和lLastTargetRow）
对于rng中的每个单元
sConcat=单元和单元偏移量（，1）
lMatchedRow=dict.Item（sConcat）
如果lMatchedRow 0，则
wTgt.Range（“a”&cell.Row&“：e”&cell.Row）。值=_
wsrc.Range（“a”&lMatchedRow&“：e”&lMatchedRow）.Value
wTgt.范围（“f”和单元格行）=lMatchedRow
如果结束
下一个
端接头
以下是正确选择Microsoft脚本运行时后引用的外观：

在“源”表中创建一列，将“应用程序”和“对象”（例如“应用程序~~对象”）连接起来。在“目的地”工作表上使用VLOOKUP（）搜索该列并返回所需字段。知道为什么这样做行不通吗=VLOOKUP（A2和B2，间接（NextSheetName（）&“！A2:！B3”），3）获取#REF！Error为什么要使用间接（）？看起来我可能不需要它。如果我使用：=VLOOKUP（A2&B2，NextSheetName（）&A2:E3,3），我得到0，如果我使用A2:B3，我得到一个#值！错误。应该是这样的：
=VLOOKUP（A2&B2，Sheet2！$A$2:$E$3,3，FALSE）
不要忽略FALSE，除非您想要一个“近似”匹配。顶级解决方案在我的示例中非常有效！不幸的是，我不能让它在我的现实世界的问题，这是我的错误。我在Object和Owner之间还有一列，数据从A3开始。我得到一个1004错误。“无法在数据透视表中输入空值作为项或字段名。对于底部解决方案，我收到一个457错误，错误为“键已与此集合的元素关联”。代码中会有什么变化？”？ 
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

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