Question

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

如果两个列都在表1和表2中匹配，那么它将显示到sheet3，显示匹配。不幸的是，我只能匹配一列然后显示到表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中找到匹配，则在Sht2Rng2中进行第二次搜索，并且只有在找到第二次搜索时才将值写入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并声明所有变量。有一天，它会为你节省很多很多小时的头发。

Excel中的VBA匹配

2 个答案: