[原创文章] 比较Excel的VBS函数
QTP中Excel的比较
最近在SQAForum经常有人提出关于比较两个Excel的值的问题的帖子
例如：
http://www.sqaforums.com/showflat.php?Cat=0&Number=549014&an=0&page=0#Post549014
http://www.sqaforums.com/showflat.php?Cat=0&Number=567634&an=0&page=0#Post567634
国人肯定在此问题上也会有一定的困惑，我把自己写的一些函数发出来，给大家予以一定的启发和思路
两个Excel比较的函数：
'*************************************************
'** Functionality: compare two excels
'** input parameter:
'** excelFullPath1 - the first excelsheet
'** excelFullPath2 - the secondexcel sheet
'** output: if excel sheet are equal, return "equal",else return difference
'** Author: Wally Yu in Shanghai,[email protected]
'** Date:1st May 2009
'*************************************************
Function CompareExcelSheet(excelFullPath1, excelFullPath2,sheetName)
Dim rows1,rows2, columns1, columns2,ret, i,j, tempDoc1,tempDoc2, diffFlag
diffFlag = False
Dim srcData1,srcDoc1
set srcData1 =CreateObject("Excel.Application")
srcData1.Visible = False
set srcDoc1 =srcData1.Workbooks.Open(excelFullPath1)
srcDoc1.Worksheets(sheetname).Activate
rows1 =srcDoc1.Worksheets(sheetname).UsedRange.rows.Count
columns1 =srcDoc1.Worksheets(sheetname).UsedRange.columns.Count
Dim srcData2,srcDoc2
set srcData2 =CreateObject("Excel.Application")
srcData2.Visible = False
set srcDoc2 =srcData2.Workbooks.Open(excelFullPath2)
srcDoc2.Worksheets(sheetname).Activate
rows2 =srcDoc1.Worksheets(sheetname).UsedRange.rows.Count
columns2 = srcDoc1.Worksheets(sheetname).UsedRange.columns.Count
If (rows1 <> rows2) Or (columns1<> columns2) Then
ret = "Excel sheet "& sheetName & "used ranges are not equal"
diffFlag = True
Else
For i = 1 To rows1
For j = 1 Tocolumns1
tempDoc1= srcDoc1.Worksheets(sheetname).Cells(i,j).value
tempDoc2= srcDoc2.Worksheets(sheetname).Cells(i,j).value
IftempDoc1 <> tempDoc2 Then
diffFlag= True
ret= ret & "cell(" & i & ","& j & ") values are differert: value1 = " & tempDoc1& ", value2 = " &tempDoc2 & vbCrLf
End If
Next
Next
ret = "Excel sheet "& sheetName & "cells are different:" & vbCrLf & ret
End If
If diffFlag = False Then
ret = "equal"
End If
'srcDoc1.Close
'scrDoc2.Close
CompareExcelSheet = ret
srcData1.Workbooks.Close
srcData2.Workbooks.Close
srcData1.Quit
srcData2.Quit
' QTP_Read_Excel = ret
End Function
读取Excel单元格的函数：
PublicFunction readExcelCell(pathway,sheetname,x,y)
On Error Resume Next
Setfso=CreateObject("scripting.FileSystemObject")
If fso.FileExists(pathway) Then
Dim srcData,srcDoc,ret
set srcData =CreateObject("Excel.Application")
srcData.Visible = False
set srcDoc =srcData.Workbooks.Open(pathway)
srcDoc.Worksheets(sheetname).Activate
ret =srcDoc.Worksheets(sheetname).Cells(x,y).value
srcData.Workbooks.Close
srcData.Quit
Else
ret = "file notfound"
End If
Set fso = Nothing
Set srcData = Nothing
If Err Then
readExcelCell = Err.Description
Else
readExcelCell = ret
End If
End Function
写入Excel单元格函数
PublicFunction writeExcelCell(content,pathway,sheetname,x,y)
On Error Resume Next
Setfso=CreateObject("scripting.FileSystemObject")
If fso.FileExists(pathway) Then
Dim srcData,srcDoc,ret
set srcData =CreateObject("Excel.Application")
srcData.Visible = False
set srcDoc =srcData.Workbooks.Open(pathway)
srcDoc.Worksheets(sheetname).Activate
srcDoc.Worksheets(sheetname).Cells(x,y).value = content
srcDoc.Save
srcData.Workbooks.Close
srcData.Quit
ret = "success"
Else
ret = "File notfound"
End If
Set fso = Nothing
Set srcData = Nothing
If Err Then
writeExcelCell =Err.Description
Else
writeExcelCell = ret
End If
End Function
注：
这三个函数都是对Excel的基本操作，我们只是给还没有掌握的测试界的朋友一个基本思路
其实在真正自动化测试过程中可能需要更多的对于Excel的操作，各位朋友都可以参照这样的思路实现自己的操作鄙人微博：http://weibo.com/quicktest，愿与大家一起讨论