在两者中比较2个excel表和普通键

我正在寻找VBA代码来比较同一工作簿中的Excel工作表eg-Sheet1 vs Sheet2和Sheet3是供用户定义比较总行和列以及用于准备密钥的列 .

表格如下:

列和行不是固定的,因此如果用户获得了在sheet3和代码句柄中定义的选项 . 准备密钥 - 用户可以选择sheet3中的列 . 每个密钥的差异应填写在Sheet4中,其中包含Key和列,并且不同的值如下所示 -

工作表Sheet1

Column A CHDR 01234
Column B Life 01
Column C CRT abc
Column D Prem 10
Column E SA 1000

Sheet2中

Column A CHDR 01234
Column B Life 01
Column C CRT abc
Column D Prem 10
Column E SA 1002

键应该是列A,B,C因此应该在Sheet4中填充差异

Column A Key 01234-01-abc
Column B Difference SA-1000-1002

这是我目前的代码 -

Dim recordStatus As String
    Dim oldCell As Range
    Dim compareCell As Range
    Dim keyToCompare As Variant
    Dim i As Integer
    Dim newCell As Range

    Set newCell = Worksheets("CHDR-JSYS").Range("A2")

    Do While newCell.Value <> ""

        keyToCompare = newCell.Resize(1, 26).Value                   ' copy row of cells ... one extra cell at end
        keyToCompare = Application.Transpose(keyToCompare)            ' convert to
        keyToCompare = Application.Transpose(keyToCompare)            ' single dimension array

        Set oldCell = Worksheets("CHDR-JACT").Range("A2")              ' set pointer to cell A2

        Do While oldCell.Value <> ""                               ' process all non-blank cells

            Set compareCell = Worksheets("Compare").Range("A2")   ' set pointer to cell A1

            If oldCell.Value = keyToCompare(1) Then
                If ( _
                        (oldCell.Offset(0, 1).Value = keyToCompare(2)) _
                    And (oldCell.Offset(0, 2).Value = keyToCompare(3)) _
                    And (oldCell.Offset(0, 3).Value = keyToCompare(4)) _
                    And (oldCell.Offset(0, 4).Value = keyToCompare(5)) _
                    And (oldCell.Offset(0, 5).Value = keyToCompare(6)) _
                    And (oldCell.Offset(0, 6).Value = keyToCompare(7)) _
                    And (oldCell.Offset(0, 7).Value = keyToCompare(8)) _
                    And (oldCell.Offset(0, 8).Value = keyToCompare(9)) _
                    And (oldCell.Offset(0, 9).Value = keyToCompare(10)) _
                    And (oldCell.Offset(0, 10).Value = keyToCompare(11)) _
                    And (oldCell.Offset(0, 11).Value = keyToCompare(12)) _
                    And (oldCell.Offset(0, 12).Value = keyToCompare(13)) _
                    And (oldCell.Offset(0, 13).Value = keyToCompare(14)) _
                    And (oldCell.Offset(0, 14).Value = keyToCompare(15)) _
                    And (oldCell.Offset(0, 15).Value = keyToCompare(16)) _
                    And (oldCell.Offset(0, 16).Value = keyToCompare(17)) _
                    And (oldCell.Offset(0, 17).Value = keyToCompare(18)) _
                    And (oldCell.Offset(0, 18).Value = keyToCompare(19)) _
                    And (oldCell.Offset(0, 19).Value = keyToCompare(20)) _
                    And (oldCell.Offset(0, 20).Value = keyToCompare(21)) _
                    And (oldCell.Offset(0, 21).Value = keyToCompare(22)) _
                    And (oldCell.Offset(0, 22).Value = keyToCompare(23)) _
                    And (oldCell.Offset(0, 23).Value = keyToCompare(24)) _
                    And (oldCell.Offset(0, 24).Value = keyToCompare(25))) Then

                    recordStatus = "No Change"
                Else
                    recordStatus = "Change"
                End If

            Else
                recordStatus = "New Record"
            End If

            keyToCompare(26) = recordStatus

            For i = 1 To 25                                          ' update 5 cells in output workbook
                compareCell.Offset(0, i).Value = keyToCompare(i + 1)
            Next i

            Set oldCell = oldCell.Offset(1, 0)                ' move pointer one cell down
            Set compareCell = compareCell.Offset(1, 0)        ' this is missing from original code

        Loop
        Set newCell = newCell.Offset(1, 0)
    Loop
End Sub

但我无法在其中添加更多列进行比较,因为它给了我错误“太多行继续” . 我必须比较超过40-50列 .

在此先感谢您的帮助

回答(1)

2 years ago

您可以使用循环代替所有这些 And 行:

If oldCell.Value = keyToCompare(1) Then
    recordStatus = "No Change" 'default is no change until we detect a change

    Dim c As Long
    For c = 1 To 24 'loop throug all values and check for a change
        If oldCell.Offset(0, c).Value <> keyToCompare(c + 1) Then
            recordStatus = "Change" 'change detected
            Exit For 'stop looping (one change is enough to change the status)
        End If
    Next c
Else
    recordStatus = "New Record"
End If

根据您的需要调整循环 For c = 1 To 24 ,例如 . 列数要检查 .