VBA - 如何匹配两个不同工作表中的标题以确保它们具有相同的名称和相同的顺序？

Question

我有两个 Excel 工作表 ReportOld 和 ReportNew，我想要检查并确保两个工作表中的所有列牧者的名称都匹配并且顺序相同。基本上需要检查不应该从上次报告中添加或删除任何新列。机器人是相同的。

到目前为止我尝试过的代码是:

Sub colLookup()

Dim ShtOne As Worksheet, ShtTwo As Worksheet
Dim shtOneHead As Range, shtTwoHead As Range
Dim headerOne As Range, headerTwo As Range
Dim x As Integer
Dim lastCol As Long

Set ShtOne = Sheets("ReportOld")
Set ShtTwo = Sheets("ReportNew")

lastCol = ShtOne.Cells(1, Columns.Count).End(xlToLeft).Column
Set shtOneHead = ShtOne.Range("A1", ShtOne.Cells(1, lastCol))

lastCol = ShtTwo.Cells(1, Columns.Count).End(xlToLeft).Column
Set shtTwoHead = ShtTwo.Range("A1", ShtTwo.Cells(1, lastCol))

For Each headerTwo In shtTwoHead
    For Each headerOne In shtOneHead
        If headerTwo.Value = headerOne.Value Then

        Else
        x = MsgBox("Headers are not matching in both sheets.")
        MsgBox "value is:" & headerTwo.Value
        Exit Sub
        End If
    Next headerOne
 Next headerTwo
End Sub    

Answer 1

试试这个代码。它计算两张纸上的标题并填充两张纸上的标题数组。然后，它会比较每张纸的标题，如果标题不匹配，则显示一条消息。然后它会比较列数，如果不匹配，则会显示另一条消息...

Sub colLookup()

Dim ShtOne As Worksheet, ShtTwo As Worksheet
Dim shtOneHead As Range, shtTwoHead As Range
Dim headerOne As Range, headerTwo As Range
Dim x As Integer
Dim lastCol As Long

Set ShtOne = Sheets("ReportOld")
Set ShtTwo = Sheets("ReportNew")

lastCol = ShtOne.Cells(1, Columns.Count).End(xlToLeft).Column
Set shtOneHead = ShtOne.Range("A1", ShtOne.Cells(1, lastCol))

lastCol = ShtTwo.Cells(1, Columns.Count).End(xlToLeft).Column
Set shtTwoHead = ShtTwo.Range("A1", ShtTwo.Cells(1, lastCol))

For Each headerTwo In shtTwoHead
    For Each headerOne In shtOneHead
        If headerTwo.Value = headerOne.Value Then

        Else
        x = MsgBox("Headers are not matching in both sheets.")
        MsgBox "value is:" & headerTwo.Value
        Exit Sub
        End If
    Next headerOne
 Next headerTwo
End Sub

Sub new_code()

    Dim a As Integer
    Dim b As Integer
    Dim x As Integer
    Dim HeadNew As Integer
    Dim HeadOld As Integer
    Dim HeadingsNew() As String
    Dim HeadingsOld() As String

    a = 1
    b = 1
    HeadNew = 0
    HeadOld = 0

    Erase HeadingsNew
    Erase HeadingsOld


    Worksheets("ReportNew").Activate

    Do Until Len(Trim(Cells(1, a))) = 0

        DoEvents

        ReDim Preserve HeadingsNew(1 To a)
        HeadingsNew(a) = Trim(Cells(1, a))

        a = a + 1
    Loop

    a = a - 1
    HeadNew = a

    Worksheets("ReportOld").Activate

    Do Until Len(Trim(Cells(1, b))) = 0

        DoEvents

        ReDim Preserve HeadingsOld(1 To b)
        HeadingsOld(b) = Trim(Cells(1, b))

        b = b + 1
    Loop

    b = b - 1
    HeadOld = b

    x = 1

    Do Until x > a

        DoEvents

        If HeadingsNew(x) <> HeadingsOld(x) Then

            MsgBox " Headings are different" & Chr(10) & Chr(10) & _
            " column number " & x & Chr(10) & _
            " ReportNew:  " & (HeadingsNew(x)) & Chr(10) & _
            " ReportOld:  " & (HeadingsOld(x)), vbCritical, "Data Issue"

       End If

       x = x + 1

    Loop

    If HeadOld <> HeadNew Then
        MsgBox "  The number of headings don't match", vbcritacal, "Data Issue"
    End If


End Sub