Excel VBA:一致する複合キーを見つけて残りの値を比較する

2つのワークシートがあり、ワークシートBのワークシートAの複合キー(列A、B、C)を見つける必要があります。一致した場合は、残りの値(例:列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

サンプルシート:

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
ベストアンサー

ここにいくつかの問題があります:

の修飾されていない参照は、
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

これがすべての問題であるかどうかはわかりません(密接に分析していない)。あなたがまだ問題を抱えている場合は、ポストバック…

編集

その他の質問に投稿したデータとあなたのコメントに基づいて、コードのリファクタリングを行います

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

これは、シート(2)の各行のシート(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

By the way, see This page for reason why to use
variant arrays rather than Find

コメントする

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です