Excel中的VBA匹配

我必须比较表1和表2：两列。

如果两个表都匹配表1和2，那么它将显示到表3，显示匹配。 不幸的是，我只能匹配一列，然后显示到表3。

这里是我的代码：

Sub FindMatches() Dim Sht1Rng As Range Dim Sht2Rng As Range Set Sht1Rng = Worksheets("Sheet1").Range("B1", Worksheets("Sheet1").Range("B65536").End(xlUp)) Set Sht2Rng = Worksheets("Sheet2").Range("H1", Worksheets("Sheet2").Range("H65536").End(xlUp)) For Each c In Sht1Rng Set d = Sht2Rng.Find(c.Value, LookIn:=xlValues) If Not d Is Nothing Then Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).Value = c.Value Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(0, 1).Value = c.Offset(0, 2).Value Set d = Nothing End If Next c End Sub 

Answer 1

为了在“Sheet3”中显示结果，需要“Sheet1”和“Sheet2”中的两列具有相同的值。

因此，你可以使用Application.Match ，它会简化和缩短你的代码很多：

 Option Explicit Sub FindMatches() Dim Sht1Rng As Range Dim Sht2Rng As Range Dim C As Range With Worksheets("Sheet1") Set Sht1Rng = .Range("B1", .Range("B65536").End(xlUp)) End With With Worksheets("Sheet2") Set Sht2Rng = .Range("H1", .Range("H65536").End(xlUp)) End With For Each C In Sht1Rng If Not IsError(Application.Match(C.Value, Sht2Rng, 0)) Then ' <-- successful match in both columns Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).Value = C.Value Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(0, 1).Value = C.Offset(0, 2).Value End If Next C End Sub 

Answer 2

我在你的代码中添加了一个虚构的Sht2Rng2 。 现在，如果在Sht2Rng发现匹配，则在Sht2Rng进行第二次search，并且只有在find第二个时才写入到Sheet3中。 根据需要调整Sht2Rng2的定义。

 Sub FindMatches() Dim Sht1Rng As Range Dim Sht2Rng As Range, Sht2Rng2 As Range Dim C As Range, D As Range Dim R As Long With Worksheets("Sheet1") Set Sht1Rng = .Range("B1", .Range("B65536").End(xlUp)) End With With Worksheets("Sheet2") Set Sht2Rng = .Range("H1", .Range("H65536").End(xlUp)) Set Sht2Rng2 = .Range("J1", .Range("H65536").End(xlUp)) End With For Each C In Sht1Rng Set D = Sht2Rng.Find(C.Value, LookIn:=xlValues) If Not D Is Nothing Then Set D = Sht2Rng2.Find(C.Value, LookIn:=xlValues) If Not D Is Nothing Then With Worksheets("Sheet3") R = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 .Cells(R, 1).Value = C.Value .Cells(R + 1, 1).Value = C.Offset(0, 2).Value End With End If End If Next C End Sub 

您应该在代码表顶部添加Option Explicit并声明所有variables。 总有一天，你会挽救你很多很多小时的头发。