[原创文章] 比较Excel的VBS函数

QTP中Excel的比较

作者：Wally Yu (微博： http://weibo.com/quicktest)

最近在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,quicktest@yahoo.cn

'**     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，愿与大家一起讨论