EXCEL数据比对

' srcPath:TRAS导出的EXCEL存放的路径
' srcPath:BI导出的EXCEL存放的路径
Dim srcPath,disPath,IfFound
srcPath="E:\CompareExcel\TRAS(ZDSY).xls"
disPath="E:\CompareExcel\BI(YB-JB).xls"

' src: EXCEL对象
' srcExcel: TRAS导出的EXCLE的workbooks对象
' disExcel: BI导出的EXCLE的workbooks对象
' srcSheetCount:TRAS导出的EXCEL的sheet总数
' disSheetCount:BI导出的EXCEL的Wsheet总数
Dim src,srcExcel,disExcel,srcSheetCount,disSheetCount
Set Excelobj=CreateObject("Excel.Application")
oExcelobj.visible=false
Set srcExcel=oExcelobj.workbooks.open(srcPath)
srcSheetCount=osrcExcel.worksheets.count
Set disExcel=oExcelobj.workbooks.open(disPath)
disSheetCount=odisExcel.worksheets.count

' 遍历TRAS-EXCEL的sheets，在BI-EXCEL的sheets中查找匹配的sheets
' 如找到则调用CompareEXCEL(srcPath,disPath,s1,s2)函数
For s1=1 to srcSheetCount
 Datatable.GetSheet("Global").SetCurrentRow(s1)
 srcSheetName=trim(osrcExcel.sheets(s1).name)
 Datatable.Value("A","Global")=srcsheetName ' 将TRAS-EXCEL的sheet名记录在datatable的Global表的A列
 For s2=1 to disSheetCount
  cStr1=""
  disSheetName=trim(odisExcel.sheets(s2).name)
  For cnt=1 to len(disSheetName)
   c=mid(disSheetName,cnt,1)
   If (c>="0" and c<="9") or (c>="a" and c<="z") or (c>="A" and c<="Z")  Then
    cStr1=cStr1+c
   End If
  Next
  If srcSheetName=cStr1 Then
   Datatable.Value("B","Global")=dissheetName '将BI-EXCEL中找到相匹配的sheet名记录在datatable的Global表的B列
   Call CompareEXCEL(srcPath,disPath,s1,s2)
  End If
 Next
Next

' 如果TRAS-EXCEL的sheets数目小于BI-EXCEL的sheets数目
' 则遍历BI-EXCEL，在datatable的Global表的B列，查找不存在B列的sheets,将其记录到B列
If srcSheetCount<disSheetCount Then
 For s1=1 to disSheetCount
  disSheetName=trim(odisExcel.sheets(s1).name)
  For s2=1 to srcSheetCount
   disStr=Datatable.Value("B","Global")
   nPos=Instr(1,disSheetName,disStr,1)
   If nPos=0 Then
    n=n+1
    DataTable.GetSheet("Global").SetCurrentRow(srcSheetCount+n)
    DataTable.Value("B","Global")=disSheetName
   End If
  Next
 Next
End If

'For s1=1 to srcSheetCount
' Datatable.GetSheet("Global").SetCurrentRow(s1)
' srcSheetName=trim(osrcExcel.sheets(s1).name)
' Datatable.Value("A","Global")=srcsheetName
' For s2=1 to disSheetCount
'  disSheetName=trim(odisExcel.sheets(s2).name)
'  nPos=Instr(1,disSheetName,srcSheetName,1)
'  If nPos<>0 Then
'   Datatable.Value("B","Global")=dissheetName
'   Call CompareEXCEL(srcPath,disPath,s1,s2)
'  End If
' Next
'Next

Function CompareEXCEL(srcExcelPath,disExcelPath,srcsheet,dissheet)

 Dim src,srcExcel
 Set src=CreateObject("Excel.Application")
 src.visible=false
 Set srcExcel=src.workbooks.open(srcExcelPath)

 Dim dis,disExcel
 Set dis=CreateObject("Excel.Application")
 dis.visible=false
 Set disExcel=src.workbooks.open(disExcelPath)

 Dim i,j,rowcount1,columncount1,rowcount2,columncount2
 Dim diffFlag1,diffFlag2,cMsg1,cMsg2,cMsg3,cMsg
 diffFlag1=false
 diffFlag2=false
 cMsg1=""
 cMsg2=""
 cMsg3=""
 cMsg=""

 'rowcount1:srcsheet已使用过的行数
 'columncount1:srcsheet已使用过的列数
 'rowcount2:dissheet已使用过的行数
 'columncount2:dissheet已使用过的列数
 rowcount1=srcExcel.worksheets(srcsheet).usedrange.rows.count
 columncount1=srcExcel.worksheets(srcsheet).usedrange.columns.count
 rowcount2=disExcel.worksheets(dissheet).usedrange.rows.count
 columncount2=disExcel.worksheets(dissheet).usedrange.columns.count

 '查找出srcsheet为数字表元的起始行列号
 For m1=1 to rowcount1
  For n1=1 to columncount1
   cValue=srcExcel.worksheets(srcsheet).cells(m1,n1).value
   If Isnumeric(cValue) and Isempty(cValue)=false Then
    srcStartRow=m1
    srcStartColumn=n1
    Exit For
   End If
  Next
  If Isnumeric(cValue) and Isempty(cValue)=false Then
   Exit for
  End If
 Next

 '查找出dissheet为数字表元的起始行列号
 For m2=1 to rowcount2
  For n2=1 to columncount2
   cValue=disExcel.worksheets(dissheet).cells(m2,n2).value
   If Isnumeric(cValue) and Isempty(cValue)=false Then
    disStartRow=m2
    disStartColumn=n2
    Exit For
   End If   
  Next
  If Isnumeric(cValue) and Isempty(cValue)=false Then
   Exit for
  End If
 Next

 'nrNumdissheet和srcsheet起始行的差额
 'ncNumdissheet和srcsheet起始列的差额
 nrNum=disStartRow-srcStartRow
 ncNum=disStartColumn-srcStartColumn

 'srcsheet除去表尾不是数据区域的行数
 For k1=srcStartRow to rowcount1
  cString=srcExcel.worksheets(srcsheet).cells(k1,1).value
  searchChar="注"
  nPos=instr(1,cString,searchChar,1)
  If nPos<>0 then
   nrowcount1=k1-1
   Exit for
  end if
        if len(trim(cString))=0 then
   nrowcount1=k1
   Exit For
  end if
  If k1=rowcount1 Then
   nrowcount1=k1
  End If
 Next

 'dissheet除去表尾不是数据区域的行数
 Dim p1
 p1=rowcount2
 Do while p1>disStartRow
  cString=trim(disExcel.worksheets(dissheet).cells(p1,disStartColumn).Value)
  If len(cString)<>0 Then
   nrowcount2=p1
   Exit Do
  End If
  p1=p1-1
 Loop

 'numRowCount1:srcsheet实际的数据区域的行数
 'numRowCount2:dissheet实际的数据区域的行数
 numRowCount1=nrowcount1-srcStartRow+1
 numRowCount2=nrowcount2-disStartRow+1
 
 If numRowCount1<>numRowCount2 Then
   cMsg1="行数不一致" & "(" & numRowCount1 & "," & numRowCount2 & ")" & "；"
 End If

 If columncount1<>columncount2 Then
  cMsg2="列数不一致"  & "(" & columncount1 & "," & columncount2 & ")" & "；"
 End If

 If cMsg1<>"" or cMsg2<>"" Then
  diffFlag1=true
 End If

 '如果行数一致，则比较列
 If cMsg1="" Then
  For j=srcStartColumn to columncount1
   srcExcel.worksheets(srcsheet).activate
   columnName1=trim(srcExcel.worksheets(srcsheet).cells(srcStartRow-1,j).value)
   columnWidth=srcExcel.worksheets(srcsheet).Columns(j).ColumnWidth
   If columnWidth<>0 Then ' 如果srcsheet中该列不是隐藏列，则比较dissheet中相应的列，否则不比较；
    nCnt=nCnt+1 'nCnt为不是隐藏列的列数；
    For k=disStartColumn+nCnt-1 to columncount2
     columnName2=trim(disExcel.worksheets(dissheet).cells(disStartRow-1,k).value)
     For i=srcStartRow to nrowcount1
      srcvalue=trim(srcExcel.worksheets(srcsheet).cells(i,j).value)
      disvalue=trim(disExcel.worksheets(dissheet).cells(i+nrNum,k).value) 'dissheet中相对应的行的位置
      If srcvalue<>disvalue Then
       diffFlag2=true
       cMsg3="有表元的值不一致；"
       src.visible=false
       'srcExcel.worksheets(srcsheet).activate
       srcExcel.worksheets(srcsheet).cells(i,j).interior.Color = vbred
       srcExcel.worksheets(srcsheet).cells(i,j).Font.Bold = true
      End If 
     Next
     If i=nrowcount1+1 Then
      Exit For  '如果此列比较完，则进行退出dissheet列的循环
     End If
    Next
   else
    srcExcel.worksheets(srcsheet).activate
    srcExcel.worksheets(srcsheet).cells(srcStartRow-1,j).interior.Color = vbyellow
   End If
  Next
 End If

    If diffFlag1=true or diffFlag2=true or diffFlag3=true Then
  cMsg=cMsg1 & cMsg2 & cMsg3
 End If

 Datatable.Value("C","Global")=cMsg

    If diffFlag1=true or diffFlag2=true Then
  sSheetName=srcExcel.worksheets(srcsheet).name
  savePath="E:\CompareExcel\Results\" & sSheetName & ".xls"
  src.ActiveWorkbook.SaveAs   savePath
 End If

 srcExcel.close
 disExcel.close
 src.quit
 dis.quit
 Set srcExcel=nothing
 Set disExcel=nothing
 Set src=nothing
 Set dis=nothing
End Function

DataTable.Export ("E:\CompareExcel\Results\results.xls")