比较两张纸之间的所有数据，在新纸上打印标题和键

Question

目标： 从 DL 表上的 NuMAP 查找主键匹配。如果未找到，则将 NuMAP A 列中的主键打印到错误表上。如果找到，则遍历该行中的所有单元格，比较 2 个工作表（DL，NuMAP）之间的数据。如果 NuMAP 表上的数据与给定（键、列）的 DL 表上的数据不相等，则在新表上打印列和键。

数据结构： 两张表的第一列都有一个主键。两张纸之间的列的顺序相同，但行的顺序不同。工作表之间可能有不同数量的行。

问题：代码的基础来自here。它正确地循环通过工作表，但我不确定如何更改它以复制标题和密钥并将其放在新工作表上。我已经对如何做到这一点做出了最好的猜测，但希望得到一些帮助。

Sub DetectChanges()
    Dim DL As Worksheet, NuMAP As Worksheet '<-- explicitly declare each variable type
    Dim DLData, ErrorShtrng As Range, f As Range, cell As Range
    Dim icol, lastrow As Long
    Dim ErrorSht

    Set DL = Worksheets("Account_Master_DL").columns(1).SpecialCells(xlCellTypeConstants) '<-- set a range with DL cells containing data
    Set ErrorSht = Worksheets("Acct_master_Error")
    lastrow = ErrorSht.Cells(Rows.Count, "A").End(xlUp).Row
    Set ErrorShtrng = ErrorSht.Range("A" & lastrow)


    With Worksheets("Account_Master_NuMAP") '<--| reference NuMAP
        For Each cell In Intersect(.UsedRange, .columns(1)).SpecialCells(xlCellTypeConstants) '<-_| loop through its column "A" non blank cells
            Set f = DLData.Find(what:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole) '<--| search for current cell value in DL data
            If f Is Nothing Then '<--| if not found then...
                Intersect(cell.EntireRow, .UsedRange).Address.Copy ErrorShtrng '<--| copy primary key from column A into Errorsht Col A next open row, put "All" in Col B
            Else
                For icol = 1 To .Range(cell, .Cells(cell.Row, .columns.Count).End(xlToLeft)).columns.Count - 1 '<--| loop through NuMAP current cell row
                    If f.Offset(, icol) <> cell.Offset(, icol) Then '<--| if it doesn't match corresponding cell in DL
                        cell.Offset(, icol).Copy ErrorShtrng '<--| copy primary key in Column A, Header of column to ErrorSht columns A, B

                    End If
                Next icol
            End If
        Next cell
    End With
End Sub

Answer 1

已编译但未测试：

Sub DetectChanges()

    Dim ErrorShtrng As Range, f As Range, cell As Range, icol As Long
    Dim wsError As Worksheet, wsDL As Worksheet, wsNuMAP As Worksheet

    Set wsError = ThisWorkbook.Worksheets("Acct_master_Error")
    Set wsDL = ThisWorkbook.Worksheets("Account_Master_DL")
    Set wsNuMAP = Worksheets("Account_Master_NuMAP")

    Set ErrorShtrng = wsError.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) '<< next empty row

    With wsNuMAP
        For Each cell In Intersect(.UsedRange, .Columns(1)).SpecialCells(xlCellTypeConstants)
            Set f = wsDL.Columns(1).Find(what:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
            If f Is Nothing Then
                Intersect(cell.EntireRow, .UsedRange).Copy ErrorShtrng
                Set ErrorShtrng = ErrorShtrng.Offset(1, 0) 'next row
            Else
                For icol = 1 To .Range(cell, .Cells(cell.Row, .Columns.Count).End(xlToLeft)).Columns.Count - 1
                    If f.Offset(, icol) <> cell.Offset(, icol) Then
                        ErrorShtrng.Value = cell.Value
                        ErrorShtrng.Offset(0, 1).Value = cell.Offset(, icol).EntireColumn.Cells(2).Value 'if headers in row2
                        Set ErrorShtrng = ErrorShtrng.Offset(1, 0)
                    End If
                Next icol
            End If
        Next cell
    End With
End Sub