2012-08-09 39 views
-1

如果符合特定条件,我需要创建一个宏(或函数)将单元格从相邻工作表复制到当前工作表。查找并将相邻工作表中的单元格复制到当前工作表中

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

enter image description here

下面是当前工作表,我需要复制上面的字段。请注意,应用程序没有按照相同的顺序列出。这将是这种情况,因为我永远不知道数据将以何种顺序存在,或者相同的数据甚至会在新的工作表中。

enter image description here

到目前为止,我已经尝试了这个功能:

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

这将仅在工作表具有相同顺序的相同数据的情况下起作用。

有没有人有任何想法如何做到这一点?

+0

在连接“应用程序”和“对象”(例如“Application ~~对象”)的“源代码”表中创建一个列。使用您的“目的地”工作表上的VLOOKUP()来搜索该列并返回所需的字段。 – 2012-08-09 18:40:41

+0

任何想法为什么这不起作用? = VLOOKUP(A2&B2,INDIRECT(NextSheetName()&“!A2:!B3”),3)获得#REF!错误 – rupes0610 2012-08-09 19:14:29

+0

你为什么使用INDIRECT()? – 2012-08-09 20:30:43

回答

1

如果您想使用VBA执行此操作,请尝试以下操作。该代码将匹配来自源工作表的行匹配到目标工作表,并将匹配的源行记录到目标中,以防发现有用。我将我的工作表命名为“Source”和“Target”,并假设您想要匹配列A和B的连接。

源和目标中的行数不重要,比赛出现的顺序。

我写了两个不同的版本。第一个作品,但我不是疯了,因为它循环通过源范围寻找目标中的每个值匹配。第二个版本使用一次构建的字典。然后匹配搜索条件,而不必循环范围。请注意,要使用字典,您需要参考Microsoft脚本运行时。

第一版:(功能,但需要多个环)

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脚本运行时)

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脚本运行时:

Reference to Microsoft Scripting Runtime

+0

顶级解决方案在我的示例中非常出色!不幸的是,我不能让它在我的现实世界问题中工作,这是我的错误。我在Object和Owner之间有另一列,数据从A3开始。我收到了1004错误。 “无法在数据透视表报告中输入空值作为项目或字段名称对于底部解决方案,我得到一个457错误,指出”密钥已与此集合的元素相关联“代码中的更改会是什么? – rupes0610 2012-08-10 15:18:23

相关问题