时间戳

首页 > 解决方案 > 使用 for each 比较每个工作簿中的多个列并将第三列复制到其中一个工作簿

excel - 使用 for each 比较每个工作簿中的多个列并将第三列复制到其中一个工作簿

问题描述

我将新工作簿中的两列与工作簿 2 中的两列相匹配，然后从 Workbook2 中检索 B 列并将其复制到新工作簿中的 B 列。一些单元格将是空的。运行以下代码不会复制任何内容。我不确定我是否使用正确的方法来检索信息。

    Sub InsertDeviceName_NewBook()

      Dim w1 As Worksheet, w2 As Worksheet, wsnew As Worksheet
      Dim wbnew As Workbook
      Dim c As Range, FR As Variant
      Dim d As Range
      Dim e As Range, rng1 As Range, rng2 As Range
      Dim lr1 As Long, lr2 As Long


      Application.ScreenUpdating = False


      Set w2 = Workbooks("Book2.xlsx").ActiveSheet
      Set w1 = Workbooks("Book1.xlsx").ActiveSheet



     w1.Range("B:D").Copy
     Set wbnew = Workbooks.Add 'creates new workbook
     Columns("A:A").Select
     ActiveSheet.Paste
     Application.CutCopyMode = False
     ActiveSheet.Name = w1.Name
     Set wsnew = wbnew.ActiveSheet 'sets the active sheet in the new workbook
     lr1 = wsnew.Cells(Rows.count, 1).End(xlUp).Row
     lr2 = w2.Cells(Rows.count, 1).End(xlUp).Row


     wsnew.Sort.SortFields.Add2 Key:=Range("B1"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With wsnew.Sort
        .SetRange Range("A1:C" & lr1)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
   End With

Columns("B:B").Insert Shift:=xlToRight, _
      CopyOrigin:=xlFormatFromLeftOrAbove

      Range("B1").Select
      ActiveCell.FormulaR1C1 = "Device Name"

      Dim lr3 As Long

      lr3 = wsnew.Cells(Rows.count, 1).End(xlUp).Row

      Set rng1 = wsnew.Range("C2:D" & lr3)
      Set rng2 = w2.Range("C2:D" & lr2)

'create a loop to find matches between columns C and D in the new workbook
'and match with columns C and D in workbook 2, upon a match retrieve the information
'in column B in workbook2 and add it to Columns B in the new workbook

For Each d In rng1
    FR = Application.Match(d, rng2)
    If IsNumeric(FR) Then
    d.Offset(, -1).Value = w2.Range("B" & FR).Value
    End If

Next d

Application.ScreenUpdating = True

End Sub

标签： excelvbaforeach

解决方案

索引匹配公式在这里不起作用吗？这将捕获彼此匹配的值，然后您基本上可以复制结果并粘贴为值。

此示例使用单个单元格作为返回值，但您可以将其更改为行公式并为每一行返回正确的结果。

具有多个条件的索引匹配示例

推荐阅读