Question

我正在比较2个工作簿中的数据，列标题的顺序相同，它们是：ID，DepartmentName，Name，SalesAmount，StartDate，End Date。

目前我正在将表1中的所有单元格与表格2进行比较（例如：表格1中的单元格A1到表格2中的单元格A1）。但是，现在表2中的数据的顺序不同，因此我当前的比较方法不起作用。

如果表1包含正确的数据，我希望能够将正确的行与表2匹配，并检查数据是否仍然匹配。对于工作表2中不存在的行，显示一个表以通知我缺少哪些ID。

将细胞与细胞进行比较并识别差异的代码：

For Each mycell In ActiveWorkbook.Worksheets(shtSheet2).UsedRange
    If Not mycell.Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value Then        
        mycell.Interior.Color = vbRed
        difference = difference + 1
    End If
Next

任何建议或帮助将不胜感激！谢谢

Answer 1

你应该读下＆＃34; good＆＃34;的列表。 ID和每个ID使用Range.Find方法在shtSheet2中查找条目。如果没有找到，请复制＆＃34; good＆＃34;将数据交易到输出表。如果找到，则循环浏览比较它们的数据项。这是代码：

Dim sourceId As Range
Dim testIdData As Range
Dim outputRange As Range
Dim cellFound As Range
Dim columnNum As Integer
Dim copyTheData As Boolean
Dim difference As Integer

Const NUM_COLUMNS_DATA As Integer = 6 '

    ' Assumes that worksheet variables are already defined
    Set sourceId = ActiveWorkbook.Worksheets(shtSheet1).Range("A1")
    Set testIdData = ActiveWorkbook.Worksheets(shtSheet2).Range("A1")
    Set outputRange = ActiveWorkbook.Worksheets(shtSheet3).Range("A1")

    ' Extend testIdData to cover all rows of data
    Set testIdData = testIdData.Resize(testIdData.CurrentRegion.Rows.Count)

    Do Until sourceId.Value = ""
        copyTheData = False
        ' Look for ID in test data
        Set cellFound = testIdData.Find(What:=sourceId.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If cellFound Is Nothing Then
            ' This entry not found, so copy to output
            copyTheData = True
            outputRange.Resize(ColumnSize:=NUM_COLUMNS_DATA).Interior.Color = vbRed
        Else
            ' Test that all the items match
            ' This assumes that columns are in same order
            For columnNum = 2 To NUM_COLUMNS_DATA ' No need to test the ID column
                If sourceId.Cells(ColumnIndex:=columnNum).Value <> cellFound.Cells(ColumnIndex:=columnNum).Value Then
                    outputRange.Cells(ColumnIndex:=columnNum).Interior.Color = vbRed
                    copyTheData = True
                End If
            Next columnNum
        End If
        If copyTheData Then
            sourceId.Resize(ColumnSize:=NUM_COLUMNS_DATA).Copy
            ' Do PasteSpecial to avoid over-writing the ".Interior.Color = vbRed"
            outputRange.PasteSpecial xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False
            Set outputRange = outputRange.Offset(RowOffset:=1)
            difference = difference + 1
        End If
        Set sourceId = sourceId.Offset(RowOffset:=1)
    Loop

在将数据用于实际数据之前，请记得彻底测试。

比较2个excel工作簿中的数据（未排序的数据）

1 个答案: