Excel VBA：查找匹配的复合键，然后比较其余的值

Question

我有 2 个工作表，我需要在工作表 B 的（列 A、B 和 C）下找到工作表 A 的复合键。如果它们匹配，我将继续比较其余的值（例如：列 D-Z )。请注意，工作表 B 的行都是混乱的。到目前为止，这是我想出的。不知何故，我认为在搜索键时我做错了，因为我无法获得匹配项所在的特定行。有任何想法吗？帮助将不胜感激。

Public Sub compare()

Dim RowCount As Long
Dim StartRow As Integer
Dim ColCount As Integer
Dim StartCol As Integer
Dim Key1, Key2, Key3
Dim Target1, Target2, Target3

If Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row > Sheets(3).Cells(Rows.Count, "A").End(xlUp).Row Then
RowCount = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
Else
RowCount = Sheets(3).Cells(Rows.Count, "A").End(xlUp).Row
End If

'StartRow
SearchVal = 1
 For Each Cell In Sheets(2).Range("A1:A" & RowCount)
   If Cell.Value = SearchVal Then
    StartRow = Cell.Row
    End If
Next Cell

ColCount = Sheets(2).Cells(StartRow, Columns.Count).End(xlToLeft).Column
StartCol = 1


For i = StartRow To RowCount
    If Application.CountA(Rows(i)) <> 0 Then
    Key1 = Sheets(2).Cells(i, 1).Value
    Key2 = Sheets(2).Cells(i, 2).Value
    Key3 = Sheets(2).Cells(i, 3).Value

    Set Target1 = Sheets(3).Columns(1).Find(Key1, LookIn:=xlValues, LookAt:=xlWhole)
    Set Target2 = Sheets(3).Columns(2).Find(Key2, LookIn:=xlValues, LookAt:=xlWhole)
    Set Target3 = Sheets(3).Columns(3).Find(Key3, LookIn:=xlValues, LookAt:=xlWhole)

    If Not Target1 Is Nothing And Not Target2 Is Nothing And Not Target3 Is Nothing Then
    For j = StartCol To ColCount
   'compare each cell values

    Next j
    End If
    End If
Next i


End Sub

Excel 表格示例：

Eg:
Worksheet2
------------------------------
|   |  A | B | C |   D   | E |
------------------------------
| 1 | 03 | 5 | C | TextZ | A |
------------------------------
| 2 | 01 | 2 | 4 | TextZ | B |
------------------------------
| 3 | 01 | 2 | 4 | TextZ | C |
------------------------------
| 4 | 22 | T | N | TextZ | D |
------------------------------

Worksheet3
------------------------------
|   |  A | B | C |   D   | E |
------------------------------
| 1 | 01 | 2 | 4 | TextZ | C |
------------------------------
| 2 | 01 | 2 | 4 | TextZ | D |
------------------------------
| 3 | 22 | T | N | TextZ | A |
------------------------------
| 4 | 03 | 5 | C | TextZ | B |
------------------------------

编辑：

Public Sub compare()    
Dim sh2 As Worksheet, sh3 As Worksheet
Dim sh2Data As Variant
Dim sh3DataA As Variant 
Dim sh3Data As Variant 
Dim i2 As Long, os3 As Long, i3 As Variant
Dim DoSearch As Boolean 

Set sh2 = Sheets(2)  
Set sh3 = Sheets(3)

With sh2
SearchVal = 1
 For Each Cell In .Range("A1:A" & .Rows.Count)
   If Cell.Value = SearchVal Then
    StartRow = Cell.Row
    End If
Next Cell

    sh2Data = .Range(.[G1], .Cells(.Rows.Count, 7).End(xlUp)).Resize(, 1)
    sh2Data1 = .Range(.[J1], .Cells(.Rows.Count, 10).End(xlUp)).Resize(, 1)
    sh2Data2 = .Range(.[O1], .Cells(.Rows.Count, 15).End(xlUp)).Resize(, 1)

End With

DoSearch = False
For i2 = StartRow To UBound(sh2Data, 1)
With sh3
    sh3Data = .Range(.[G1], .Cells(.Rows.Count, 7).End(xlUp)).Resize(, 1)
    sh3Data1 = .Range(.[J1], .Cells(.Rows.Count, 10).End(xlUp)).Resize(, 1)
    sh3Data2 = .Range(.[O1], .Cells(.Rows.Count, 15).End(xlUp)).Resize(, 1)
End With
os3 = 0
    Do
    i3 = Application.Match(sh2Data(i2, 1), sh3Data, 0)
    If Application.CountA(Rows(i2)) <> 0 Then
        If Not IsError(i3) Then
        ' Col G match
            If (sh2Data1(i2, 1) = sh3Data1(i3, 1)) And (sh2Data2(i2, 1) = sh3Data2(i3, 1)) Then
            ' Match Found Sheet(2) row i2 = Sheet(3) row i3

           MsgBox "Match found sheet2 = " & i2 & ", sheet3 = " & i3 + os3
            End If

          os3 = os3 + i3
          If os3 + i3 < UBound(sh3Data, 1) Then
          With sh3
          sh3Data = .Range(.Cells(i3 + 1, 1), .Cells(.Rows.Count, 7).End(xlUp)).Resize(, 1)
          sh3Data1 = .Range(.Cells(i3 + 1, 1), .Cells(.Rows.Count, 10).End(xlUp)).Resize(, 1)
          sh3Data2 = .Range(.Cells(i3 + 1, 1), .Cells(.Rows.Count, 15).End(xlUp)).Resize(, 1)
          End With
          DoSearch = True
          Else
          DoSearch = False
          End If
          Else
          DoSearch = False
        End If
    End If
    Loop Until Not DoSearch
Next i2

End Sub

测试的数据：

Worksheet2
    ------------------------------
    |   | A  | B.. | G.. | J..| O.. |
    ------------------------------
    | 1 | 03 | zxc | 1   | 2  | 3   |
    ------------------------------
    | 2 | 03 | zxc | 1   | 3  | 4   |
    ------------------------------
    | 3 | 03 | zxc | 2   | 2  | 4   |
    ------------------------------
    | 4 | 03 | zxc | 2   | 3  | 4   |
    ------------------------------

Worksheet3

    ------------------------------
    |   | A  | B.. | G.. | J..| O.. |
    ------------------------------
    | 1 | 03 | zxc | 2   | 3  | 4   |
    ------------------------------
    | 2 | 03 | zxc | 2   | 2  | 4   |
    ------------------------------
    | 3 | 03 | zxc | 1   | 3  | 4   |
    ------------------------------
    | 4 | 03 | zxc | 1   | 2  | 3   |
    ------------------------------




So basically
sh2's 1 = sh3's = 4
sh2's 2 = sh3's = 3
sh2's 3 = sh3's = 2
sh2's 4 = sh3's = 1

& the msgbox only shows
sh2's 3 = sh3's = 2
sh2's 4 = sh3's = 1

Answer 1

这里有几个问题：

对Rows和Columns的非限定引用指的是ActiveSheet上的对象，例如

Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row

等价于

Sheets(2).Cells(Activesheet.Rows.Count, "A").End(xlUp).Row

你应该使用

    Sheets(2).Cells(Sheets(2).Rows.Count, "A").End(xlUp).Row

不确定这是否是所有问题（没有仔细分析过）。如果您仍有问题，请回帖...

编辑

根据您在 other question 上发布的数据和您的评论，这里是您的代码重构

Public Sub compare()
    Dim sh2 As Worksheet, sh3 As Worksheet
    Dim sh2Data As Variant
    Dim sh3DataA As Variant
    Dim sh3Data As Variant
    Dim i2 As Long, i3 As Long

    Set sh2 = Sheets(2)
    Set sh3 = Sheets(3)

    With sh2
        sh2Data = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3)
    End With
    With sh3            
        sh3DataA = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 1)
        sh3Data = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3)
    End With

    For i2 = 1 To UBound(sh2Data, 1)
        i3 = Application.Match(sh2Data(i2, 1), sh3DataA, 0)
        If Not IsError(rw) Then
            ' Col A match
            If (sh2Data(i2, 2) = sh3Data(i3, 2)) And (sh2Data(i2, 3) = sh3Data(i3, 3)) Then
                ' Match Found Sheet(2) row i2 = Sheet(3) row i3

            End If
        End If
    Next
End Sub

这将在 Sheet(2) 中的每一行的 Sheet(3) 中找到第一个匹配项。您是否需要继续查找 Sheet(2) 行的任何进一步匹配项？如果是这样，这里有另一个版本

Public Sub compare()
    Dim sh2 As Worksheet, sh3 As Worksheet
    Dim sh2Data As Variant
    Dim sh3DataA As Variant
    Dim sh3Data As Variant
    Dim i2 As Long, os3 As Long, i3 As Variant
    Dim DoSearch As Boolean

    Set sh2 = Sheets(2)
    Set sh3 = Sheets(3)

    With sh2
        sh2Data = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3)
    End With

    DoSearch = False
    For i2 = 1 To UBound(sh2Data, 1)
        With sh3
            sh3DataA = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 1)
            sh3Data = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3)
        End With
        os3 = 0
        Do
            If UBound(sh3Data, 1) > 1 Then
                i3 = Application.Match(sh2Data(i2, 1), sh3DataA, 0)
            Else
                i3 = IIf(sh2Data(i2, 1) = sh3DataA, 1, CVErr(xlErrNA))
            End If
            If Not IsError(i3) Then
                ' Col A match
                If (sh2Data(i2, 2) = sh3Data(i3, 2)) And (sh2Data(i2, 3) = sh3Data(i3, 3)) Then
                    MsgBox "Match found sheet2 = " & i2 & ", sheet3 = " & i3 + os3
                End If
                os3 = os3 + i3
                If os3 < UBound(sh2Data, 1) Then
                    With sh3
                        sh3DataA = .Range(.Cells(i3 + os3, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 1)
                        sh3Data = .Range(.Cells(i3 + os3, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3)
                    End With
                    DoSearch = True
                Else
                    DoSearch = False
                End If
            Else
                DoSearch = False
            End If
        Loop Until Not DoSearch
    Next
End Sub

顺便说一下，请参阅This page 了解为什么使用variant arrays 而不是Find