比较excel中的数据

问题描述

问候价
我在同一本书中有两张excel表，每张表在四列中有大约6000条记录

regards
I have two excel sheets in the same book, each sheet has around 6000 records in four columns

我需要比较如果两张表中的数据相同

I need is to compare if the data is the same in both sheets

提前感谢

推荐答案

请尝试使用以下代码。它将帮助您比较同一个Excel工作簿中的2张。

please try to use the code below. it will help you to compare the 2 sheets in same Excel Workbook.

Option Explicit

Sub CompareSheets()
'
' constants
' worksheets & ranges
' original
Const ksWSOriginal = "ORIGINAL"
 Const ksOriginal = "OriginalTable"
 Const ksOriginalKey = "OriginalKey"
' updated
Const ksWSUpdated = "UPDATED"
 Const ksUpdated = "UpdatedTable"
 Const ksUpdatedKey = "UpdatedKey"
' changes
Const ksWSChanges = "CHANGES"
 Const ksChanges = "ChangesTable"
' labels
Const ksChange = "CHANGE"
 Const ksRemove = "REMOVE"
 Const ksAdd = "ADD"
'
' declarations
Dim rngO As Range, rngOK As Range, rngU As Range, rngUK As Range, rngC As Range
Dim c As Range
Dim I As Long, J As Long, lChanges As Long, lRow As Long, bEqual As Boolean
'
' start
Set rngO = Worksheets(ksWSOriginal).Range(ksOriginal)
Set rngOK = Worksheets(ksWSOriginal).Range(ksOriginalKey)
Set rngU = Worksheets(ksWSUpdated).Range(ksUpdated)
Set rngUK = Worksheets(ksWSUpdated).Range(ksUpdatedKey)
Set rngC = Worksheets(ksWSChanges).Range(ksChanges)
With rngC
     If .Rows.Count > 1 Then
         Range(.Rows(2), .Rows(.Rows.Count)).ClearContents
         Range(.Rows(2), .Rows(.Rows.Count)).Font.ColorIndex = xlColorIndexAutomatic
         Range(.Rows(2), .Rows(.Rows.Count)).Font.Bold = False
     End If
End With
'
' process
lChanges = 1
' 1st pass: updates & deletions
With rngOK
     For I = 1 To .Rows.Count
         Set c = rngUK.Find(.Cells(I, 1).Value, , xlValues, xlWhole)
         If c Is Nothing Then
             ' deletion
            lChanges = lChanges + 1
             rngC.Cells(lChanges, 1).Value = ksRemove
             For J = 1 To rngO.Columns.Count
                 rngC.Cells(lChanges, J + 1).Value = rngO.Cells(I, J).Value
                 rngC.Cells(lChanges, J + 1).Font.Color = vbRed
                 rngC.Cells(lChanges, J + 1).Font.Bold = True
             Next J
         Else
             bEqual = True
             lRow = c.Row - rngUK.Row + 1
             For J = 1 To rngO.Columns.Count
                 If rngO.Cells(I, J).Value <> rngU.Cells(lRow, J).Value Then
                     bEqual = False
                     Exit For
                 End If
             Next J
             If Not bEqual Then
                 ' change
                lChanges = lChanges + 1
                 rngC.Cells(lChanges, 1).Value = ksChange
                 For J = 1 To rngO.Columns.Count
                     If rngO.Cells(I, J).Value = rngU.Cells(lRow, J).Value Then
                         rngC.Cells(lChanges, J + 1).Value = rngO.Cells(I, J).Value
                     Else
                         rngC.Cells(lChanges, J + 1).Value = rngU.Cells(I, J).Value
                         rngC.Cells(lChanges, J + 1).Font.Color = vbMagenta
                         rngC.Cells(lChanges, J + 1).Font.Bold = True
                     End If
                 Next J
             End If
         End If
     Next I
End With
' 2nd pass: additions
With rngUK
     For I = 1 To .Rows.Count
         Set c = rngOK.Find(.Cells(I, 1).Value, , xlValues, xlWhole)
         If c Is Nothing Then
             ' addition
            lChanges = lChanges + 1
             rngC.Cells(lChanges, 1).Value = ksAdd
             For J = 1 To rngU.Columns.Count
                 rngC.Cells(lChanges, J + 1).Value = rngU.Cells(I, J).Value
                 rngC.Cells(lChanges, J + 1).Font.Color = vbBlue
                 rngC.Cells(lChanges, J + 1).Font.Bold = True
             Next J
         End If
     Next I
End With
'
' end
Worksheets(ksWSChanges).Activate
 rngC.Cells(2, 3).Select
Set rngC = Nothing
Set rngUK = Nothing
Set rngU = Nothing
Set rngOK = Nothing
Set rngO = Nothing
 Beep
'
End Sub
  

问候

Deepak

这篇关于比较excel中的数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！