Question

我正在寻找VBA代码以与同一工作簿中的Excel工作表进行比较，例如，Sheet1 vs Sheet2和Sheet3供用户定义要比较的行和列总数以及要用来准备键的列。

内容是表格形式，

列和行不是固定的，因此如果用户可以选择在sheet3和代码句柄中定义。准备键-用户可以在sheet3中选择列每个键的差异应在Sheet4中填充，听到“键”和“列”以及不同的值，例如-

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列以上。

预先感谢您的帮助

Answer 1

您可以使用循环来代替所有这些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，例如要检查的列数。

比较两个具有相同公钥的Excel工作表

1 个答案: