Excel VBA - 在两个 Excel 表中搜索多个值

Question

我有两张 Excel 表，需要将值从一张复制到另一张。

工作表 1：一列包含 ID，另一列包含数据，我希望稍后将其显示在工作表 2 中。

工作表 2：包含相同的 ID，并且必须使用工作表 1 中的相应数据值进行扩展。

如何搜索匹配的 ID，然后将相关的数据值从一张 Excel 表复制到另一张 Excel 表？

Answer 1

您可以使用=exact()或

比较同一工作簿中的两张工作表：

1. 启用要比较两个工作表的工作簿，然后单击

查看 > 新窗口

. 2. 然后转到任务栏显示当前工作簿的新窗口

3. 从每个窗口转到要比较的两张表，并将它们并排排列

4. 现在根据需要比较两张纸。

找出差异

1. 打开包含要比较的工作表的工作簿并创建一个新工作表。

2. 在新工作表中，选择一个空白单元格，例如 A1，然后键入此公式

=IF(Sheet1!A1<> Sheet7!A1, "Sheet1:"&Sheet1!A1&" vs
    Sheet7:"&Sheet7!A1, "")

其中，Sheet1和Sheet7是要比较的工作表，A1是要比较的第一个单元格。

3. 然后将自动填充柄拖到您需要比较两张工作表的范围上。

比较两个不同工作簿中的两张工作表

如果您想要比较两个不同工作簿中的两张工作表，则可以应用并排查看实用程序来处理。

1. 打开要比较的两张工作表，然后

activate one
    sheet and click View > View Side by Side.

2. 此时两个工作簿中的两张工作表就已经水平显示了。然后您就可以根据需要对两张工作表进行对比了。

Answer 2

@Bandersnatch 是最简单的解决方案

对于工作表 1 上的数据：

。

Sheet2，B 列的公式为=VLOOKUP(A2, Sheet1!A$1:B$6, 2)

---

在 VBA 中：

---

Option Explicit

Public Sub FindValsInWS1Vlookup()

    With Sheet2.Range("B2")

        .FormulaR1C1 = "=VLOOKUP(RC[-1], Sheet1!R1C[-1]:R6C, 2)"

        .AutoFill Destination:=Range("B2:B6")

    End With

End Sub

---

另一个选项（仅限 VBA，带有字典对象）-在 Sheet 3 上：

---

Option Explicit

'Add ref in VBA window: Tools -> References... -> Microsoft Scripting Runtime

Public Sub FindValsInWS1Arrays()

    Dim arr1 As Variant, arr21 As Variant, arr22 As Variant
    Dim i As Long, j As Long, d As Dictionary

    arr1 = Sheet1.UsedRange
    arr21 = Sheet3.UsedRange.Columns(1)
    arr22 = Sheet3.UsedRange.Columns(2)
    Set d = New Dictionary

    For i = LBound(arr1) To UBound(arr1)
        d(arr1(i, 1)) = arr1(i, 2)      'read the 2 columns from ws1 into a dictionary
    Next

    For i = LBound(arr21) To UBound(arr21)
        If d.Exists(arr21(i, 1)) Then arr22(i, 1) = d(arr21(i, 1))
    Next

    Sheet3.UsedRange.Columns(2) = arr22

End Sub

---

结果：

注意：这些解决方案的 ID 不能重复

Answer 3

我想向您推荐两种方法。第一种方法是非 VBA 解决方案，另一种是 VBA。

方法 1：

在工作表 2 的单元格 A2 中使用此数组公式。

{=IFERROR(INDEX(Sheet1!$A$2:$E$6, SMALL(IF(COUNTIF($G$1, Sheet1!$A$2:$A$6), ROW(Sheet1!$A$2:$E$6)-MIN(ROW(Sheet1!$A$2:$E$6))+1), ROW(A1)), COLUMN(A1)),"")}

注意：将此公式向右拖至 E 列，然后向下。工作表 2 中的单元格 G1 具有匹配代码 Q1。

方法 2：

Sub ExtractDuplicateID()


Dim sht As Worksheet 
Dim newsht As Worksheet 


Set sht = ThisWorkbook.Worksheets("Sheet1")
Set newsht = ThisWorkbook.Worksheets("Sheet2")


Set dat = sht.Range("A1")
Set newdat = newsht.Range("A1")


Dim i, j
i = 1
j = 1


'Copy Header Values from Sheet1

newdat.Offset(0, 0).Value = dat.Offset(0, 0).Value 
newdat.Offset(0, 1).Value = dat.Offset(0, 2).Value 
newdat.Offset(0, 2).Value = dat.Offset(0, 3).Value 
newdat.Offset(0, 3).Value = dat.Offset(0, 4).Value 
newdat.Offset(0, 4).Value = dat.Offset(0, 5).Value 

Do While newdat.Offset(i, 0).Value <> "" Or newdat.Offset(i, 1).Value <> ""

  j = 1     

  Do While dat.Offset(j, 0).Value <> ""

    If (newdat.Offset(i, 0).Value = dat.Offset(j, 4).Value _
    Or newdat.Offset(i, 1).Value = dat.Offset(j, 5).Value) _
    And dat.Offset(j, 6).Value = "Q1" Then

      'Copy Header Values in Sheet2

      newdat.Offset(iRow, 0).Value = dat.Offset(j, 0).Value 
      newdat.Offset(iRow, 1).Value = dat.Offset(j, 2).Value 
      newdat.Offset(iRow, 2).Value = dat.Offset(j, 3).Value 
      newdat.Offset(iRow, 3).Value = dat.Offset(j, 4).Value 
      newdat.Offset(iRow, 4).Value = dat.Offset(j, 5).Value 

      iRow = iRow + 1
    End If
    j = j + 1     
  Loop

  i = i + 1     
Loop
End Sub

希望这对你有帮助。