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

Answer 2

我建议使用变体数组。这是一个简单的解决方案。

Sub Compare()

Dim header1 As Variant, header2 As Variant, i as long
header1 = sheets("ReportOld").Rows(1).Value
header2 = sheets("ReportNew").Rows(1).Value

For i = 1 To 100000
    If header1(1, i) <> vbNullString Then
        If header1(1, i) <> header2(1, i) Then
            MsgBox "Compare Failed at column " & i
            Exit For
        End If
    Else
        MsgBox "Compare ="
        Exit For
    End If
Next i

End Sub

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

2 个答案: