比较excel中的数据 [英] compare data in 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

提前感谢

推荐答案

你好
Augusto C，

请尝试使用以下代码。它将帮助您比较同一个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中的数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！