EXCEL数据比对
上一篇 / 下一篇 2009-08-04 12:07:52 / 个人分类:QuickTestProfessional
' 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")
TAG:
标题搜索
日历
|
|||||||||
日 | 一 | 二 | 三 | 四 | 五 | 六 | |||
1 | |||||||||
2 | 3 | 4 | 5 | 6 | 7 | 8 | |||
9 | 10 | 11 | 12 | 13 | 14 | 15 | |||
16 | 17 | 18 | 19 | 20 | 21 | 22 | |||
23 | 24 | 25 | 26 | 27 | 28 | 29 | |||
30 |
我的存档
数据统计
- 访问量: 73893
- 日志数: 117
- 图片数: 1
- 文件数: 1
- 建立时间: 2007-05-07
- 更新时间: 2011-06-16