用VBS比较两个Excel文件的数据

 
relevantcodes.com的一篇文章《VBScript: Compare 2 Excel Files》中介绍了如何用VBScript来比较两个Excel文件的数据：
http://relevantcodes.com/vbscript-compare-2-excel-files/
 
主要是使用了Excel的COM接口的range对象来实现的。支持比较数据并且高亮显示差异：
 
Class clsComparer
       '[--- Region Private Variables Start ---]
 
       Private oExcel        'Excel.Application
 
       Private arrRangeUno      'Range.Value (array) of the Primary Excel spreadsheet
 
       Private arrRangeDos      'Range.Value (array) of the Secondary Excecl spreadsheet
 
       Private oDict          'Scripting.Dictionary containing unmatched cells
 
       '[--- Region Private Variables End ---]
 
 
       '[--- Region Public Variables Start ---]
 
       Public Operation     '0: Only Compare   1: Compare & Highlight Differences
 
       '[--- Region Public Variables End ---]
 
 
       '--------------------------------------------------------
       ' Name: Function Compare [Public]
       '
       ' Remarks: N/A
       '
       ' Purpose: Compares differences between 2 Excel Spreadsheets
       '     
       ' Arguments:
       '      sWorkBookUno: Primary Excel WorkBook (with complete path)
       '      vSheetUno: Primary Excel Spreadsheet Name
       '      sWorkBookDos: Secondary Excel WorkBook (with complete path)
       '      vSheetDos: Secondary Excel Spreadsheet Name
       '
       ' Return: Boolean
       '
       ' Author: Anshoo Arora, Relevant Codes
       '
       ' Date: 03/17/2010
       '
       ' References: N/A
       '--------------------------------------------------------
       Public Function Compare(sWorkBookUno, vSheetUno, sWorkBookDos, vSheetDos)
              Dim oWorkBookUno, oWorkBookDos
 
              'New instance of Excel
              Set oExcel = CreateObject("Excel.Application")
 
              Compare = False
             
              'Open Primary WorkBook
              Set oWorkBookUno = oExcel.WorkBooks.Open(sWorkBookUno)
              'Open Secondary WorkBook
              Set oWorkBookDos = oExcel.WorkBooks.Open(sWorkBookDos)
 
              'Primary WorkBook Range
              arrRangeUno = oWorkBookUno.WorkSheets(vSheetUno).UsedRange.Value
              'Secondary WorkBook Range
              arrRangeDos = oWorkBookDos.WorkSheets(vSheetDos).UsedRange.Value
 
              'Check using CellsFound (see below) and determine any unmatched cells
              If Not CellsFound > 0 Then Compare = True
 
              'If Operation = 0, function only runs a comparison
              'If Operation = 1, function runs a comparison and highlights differences
              If Not Compare Then
                     If Operation = 1 Then
                            Dim Keys, oSheetUno, oSheetDos, iRow, iCol
 
                            Keys = oDict.Keys
 
                            Set oSheetUno = oWorkBookUno.WorkSheets(vSheetUno)
                            Set oSheetDos = oWorkBookDos.WorkSheets(vSheetDos)
 
                            'Highlight each Row/Column combination from the dictionary
                            For Each iKey in Keys
                                   iRow = CInt(Split(iKey, "|")(0))
                                   iCol = CInt(Split(iKey, "|")(1))
 
                                   'Highlight the difference in the Primary Sheet
                                   oSheetUno.Rows(iRow).Columns(iCol).Interior.ColorIndex = 3
                                   'Highlight the difference in the Secondary Sheet
                                   oSheetDos.Rows(iRow).Columns(iCol).Interior.ColorIndex = 3
                            Next
 
                            'Save primary and secondary workbooks
                            oWorkBookUno.Save
                            oWorkBookDos.Save
 
                            'Dispose primary and secondary sheet objects
                            Set oSheetUno = Nothing
                            Set oSheetDos = Nothing
                     End If
              End If
 
              'Dispose primary and secondary workbook objects
              oWorkBookUno.Close
              oWorkBookDos.Close
       End Function
 
       '--------------------------------------------------------
       ' Name: Function CellsFound [Private]
       '
       ' Remarks: N/A
       '
       ' Purpose: Finds the dissimilar cells between 2 sheets
       '     
       ' Arguments: N/a
       '
       ' Return: Integer
       '
       ' Author: Anshoo Arora, Relevant Codes
       '
       ' Date: 03/17/2010
       '
       ' References: N/A
       '--------------------------------------------------------
       Private Function CellsFound()
              Dim iBoundsUno, iBoundsDos, iCellUno, iCellDos
 
              CellsFound = 0
 
              'New instance of Scripting.Dictionary
              Set oDict = CreateObject("Scripting.Dictionary")
 
              'Get 2D upper bound for Primary Range
              iBoundsUno = UBound(arrRangeUno, 2)
              'Get 2D upper bound for Secondary Range
              iBoundsDos = UBound(arrRangeDos, 2)
 
              'If Range are not equal..
              If iBoundsUno <> iBoundsDos Then
                     Reporter.ReportEvent micWarning, "Compare", "Unequal Range."
              End If
 
              'Build a Dictionary with all unmatched cells [Private oDict]
              For iCellUno = 1 to UBound(arrRangeUno, 1)
                     For iCellDos = 1 to UBound(arrRangeUno, 2)
                            If arrRangeUno(iCellUno, iCellDos) <> arrRangeDos(iCellUno, iCellDos) Then
                                   oDict.Add iCellUno & "|" & iCellDos, ""
                            End If
                     Next
              Next
 
              'Total dissimilar cells equal CellsFound
              CellsFound = oDict.Count
       End Function
 
       '--------------------------------------------------------
       ' Name: Sub Class_Terminate [Private]
       '
       ' Remarks: N/A
       '
       ' Purpose: Disposes the Excel.Application object
       '     
       ' Arguments: N/A
       '
       ' Author: Anshoo Arora, Relevant Codes
       '
       ' Date: 03/17/2010
       '
       ' References: N/A
       '--------------------------------------------------------
       Private Sub Class_Terminate()
              If IsObject(oExcel) Then
                     If Not oExcel Is Nothing Then
                            Set oExcel = Nothing
                     End If
              End If
             
              If TypeName(oDict) = "Dictionary" Then
                     Set oDict = Nothing
              End If
       End Sub
 
End Class
 
'--------------------------------------------------------
' Name: Function CompareExcelSheets
'
' Remarks: N/A
'
' Purpose: Constructor for Class clsComparer
'     
' Arguments:
'      sWorkBookUno: Primary Excel WorkBook (with complete path)
'      vSheetUno: Primary Excel Spreadsheet Name
'      sWorkBookDos: Secondary Excel WorkBook (with complete path)
'      vSheetDos: Secondary Excel Spreadsheet Name
'      Operation: 0: Compare Only   1: Compare & Highlight Differences
'
' Return: Boolean
'
' Author: Anshoo Arora, Relevant Codes
'
' Date: 03/17/2010
'
' References: N/A
'--------------------------------------------------------
Function CompareExcelSheets(sWorkBookUno, vSheetUno, sWorkBookDos, vSheetDos, Operation)
       Dim oClass
 
       Set oClass = New clsComparer
       oClass.Operation = Operation
 
       CompareExcelSheets = oClass.Compare(sWorkBookUno, vSheetUno, sWorkBookDos, vSheetDos)
 
       Set oClass = Nothing
End Function