Question

我需要帮助进行比较。我必须比较表1和表2：两列。

如果两个列都在第1页和第2页中匹配，那么它将显示到sheet3，显示匹配和不匹配。

表1：

Column 1: ID 123 132 1234
Column 2: Amount 100 45 50

Sheet 2中：

Column 1: ID 123 132 1234
Column 2: Amount 0 45 50

我在sheet3上的显示应该显示：匹配度：

ID 132                        Amount 45
ID 1234                       Amount 50

不匹配：

ID 
123

这是我的代码：

Sub FindMatches()

    Dim Sht1Rng As Range
    Dim Sht2Rng As Range
    Dim C As Range
    Dim D As Range


    With Worksheets("Sheet1")
        Set Sht1Rng = .Range("B1", .Range("B65536").End(xlUp))
        Set Sht1Rng = .Range("D1", .Range("B65536").End(xlUp))
    End With

    With Worksheets("Sheet2")
        Set Sht2Rng = .Range("H1", .Range("H65536").End(xlUp))
        Set Sht2Rng = .Range("L1", .Range("B65536").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("Match").Range("A65536").End(xlUp).Offset(1, 0).Value = C.Value
            Worksheets("Match").Range("A65536").End(xlUp).Offset(0, 1).Value = C.Offset(0, 2).Value
        End If


    Next C

End Sub

Answer 1

你已经忘记了有一个水平的HLOOKUP来补充（更常用的）垂直VLOOKUP。

在H8（根据随附的imnage），

=HLOOKUP(H7, 1:2, 2, FALSE)

填写正确。

Answer 2

看看这是否是你要找的。我没有完全测试这个，我只通过它运行了一个场景。我重写了你以前的所作所为。

Option Explicit

Sub FindMatches()

    Dim Ws1 As Worksheet
    Set Ws1 = ActiveWorkbook.Worksheets("Sheet1")

    Dim Ws2 As Worksheet
    Set Ws2 = ActiveWorkbook.Worksheets("Sheet2")

    Dim Ws3 As Worksheet
    Set Ws3 = ActiveWorkbook.Worksheets("Sheet3")

    Dim ws2_last_row As Long
    ws2_last_row = Ws2.Range("A" & Ws2.Rows.Count).End(xlUp).Row
    Dim ws3_insert_row As Long
    ws3_insert_row = Ws3.Range("A" & Ws3.Rows.Count).End(xlUp).Row + 1
    Dim cl As Range
    For Each cl In Ws1.Range("A2:A" & Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row)

        Dim find_rng As Range
        Set find_rng = Ws2.Range("A2:A" & ws2_last_row).Find(cl.Value)

        If Not find_rng Is Nothing Then
            If find_rng.Offset(0, 1).Value = cl.Offset(0, 1).Value Then
                Ws3.Range("A" & ws3_insert_row).Value = cl.Value
                Ws3.Range("B" & ws3_insert_row).Value = cl.Offset(0, 1).Value
                ws3_insert_row = ws3_insert_row + 1
            End If
        End If


    Next cl

End Sub

在程序运行后，Sheet3看起来像这样。

VBA匹配和不匹配

2 个答案: