使用excel VBA比较不同工作表中的两个数据集和其他工作表中的打印差异?

时间:2015-06-15 10:08:03

标签: excel vba

我在两张不同的表格中有两个数据集 Sheet1是我的原始参考,sheet2用于比较。 sheet2数据应该通过Sheet1进行比较并打印整张不匹配的sheet2行  并突出显示具有不匹配数据的单元格,此差异应打印在其他列中的列标题 指定的工作表和指定的范围

还应在任何sheet3指定的范围单元格

中更新不匹配的单元格计数

以下是经过尝试的代码。任何帮助将不胜感激。

Sub CompareDataSet()
Call compareSheets("Sheet1", "Sheet2")
End Sub
Sub compareSheets(Sheet1 As String, Sheet2 As String)
Dim Cell As Range
Dim CellMisMatch As Integer
For Each Cell In ActiveWorkbook.Worksheets(Sheet1).UsedRange
If Not Cell.Value = ActiveWorkbook.Worksheets(Sheet2).Cells(Cell.Row, Cell.Column).Value Then
Let Worksheets("Sheet3").Cells(Cell.Row, Cell.Column) = Cell
Cell.Interior.Color = vbYellow
CellMisMatch = CellMisMatch + 1
End If
Next
ThisWorkbook.Sheets("Sheet3").Cells(1, 1).Value = CellMisMatch
End Sub

1 个答案:

答案 0 :(得分:0)

这是将比较sheet1和sheet2(相应的单元格)并根据结果输入到sheet3中的正确值或不匹配的代码。 Sheet1和sheet2将具有相同数量的行和列,并且标题相同,因此您可以将它们保留在sheet3中。希望它有所帮助。

Sub Compare()

'Clearing the contents of the third sheet for the fresh comparison

usedCoulms = Sheets("Sheet3").UsedRange.Columns.Count
usedRows = Sheets("Sheet3").UsedRange.Rows.Count
For i = 2 To usedRows
For j = 1 To usedCoulms
   Sheets("Sheet3").Cells(i, j).Value = ""
   Sheets("Sheet3").Cells(i, j).Interior.Color = RGB(255, 255, 255)
Next
Next

'Coulmn count of first sheet
ColumnCount = Sheets("Sheet1").UsedRange.Columns.Count
'row count of first sheet
RowCount = Sheets("Sheet1").UsedRange.Rows.Count

For i = 2 To RowCount
For j = 1 To ColumnCount
    If Sheets("Sheet1").Cells(i, j).Value <> Sheets("Sheet2").Cells(i, j).Value Then    'Comparing if values are not equal
        Sheets("Sheet3").Cells(1, j).Value = Sheets("Sheet1").Cells(1, j).Value 'Copying the Header of the Mismatched Cell
        Sheets("Sheet3").Cells(i, j).Value = CStr("MisMatch")   'If mismatch setting set value as MisMatch
        Sheets("Sheet3").Cells(i, j).Interior.Color = 65535     'Highlighting with Yellow color

    Else
        Sheets("Sheet3").Cells(i, j).Value = Sheets("Sheet1").Cells(i, j).Value
        'If values are same copy the first sheets value if dont want to copy can skip this
    End If
Next
Next

End Sub