TA的每日心情 | 无聊 2018-9-27 10:05 |
---|
签到天数: 36 天 连续签到: 1 天 [LV.5]测试团长
|
回复 8# lijingprince5
这个函数是做Excel中,2个Sheet表的比对工作,不一样的标注出来。
但这个函数中,没有写Save 和Quit操作,也没有释放,所以在做完对比和写入操作后,进程中会有个Excel,会对下次操作造成影响。所以我改了下函数:- Function CompareSheets(sheet1_t,sheet2_t,startColumn,numberOfColumns,startRow,numberOfRows,trimed,path)
- Dim returnVal 'as boolean
- returnVal=true
- Dim objExcelApp
- Dim objExcelBook
- Dim sheet1
- Dim sheet2
- Set objExcelApp=createobject("Excel.Application")
- set objExcelBook=objExcelApp.Workbooks.Open(path)
- set sheet1=objExcelBook.Worksheets.Item(sheet1_t)
- set sheet2=objExcelBook.Worksheets.Item(sheet2_t)
- If sheet1 is nothing or sheet2 is nothing Then
- CompareSheets=false
- objExcelBook.Save
- objExcelApp.Quit
- Set sheet1 = Nothing
- Set sheet2 = Nothing
- Set objExcelBook = Nothing
- Set objExcelApp = Nothing
- Exit Function
- End If
-
- 'start to compare
- Dim Value1,Value2
- For r = startRow To (startRow + (numberOfRows -1))
- For c = startColumn To (startColumn + (numberOfColumns-1))
- Value1=sheet1.Cells(r,c)
- Value2=sheet2.Cells(r,c)
- If trimed Then
- Value1 = trim(Value1)
- Value2 = trim(Value2)
- End If
-
- If Value1 <> Value2 Then
- Dim cell
- sheet2.Cells(r,c)="Compare conflict -value was ' " & Value2 & "',Expected value is '" & Value1 &"'."
- Set cell=sheet2.Cells(r,c)
- cell.Font.Color=vbRed
- returnVal=False
- End If
- Next
- Next
- CompareSheets=returnVal
-
- '保存、关闭Excel并释放
- objExcelBook.Save
- objExcelApp.Quit
- Set sheet1 = Nothing
- Set sheet2 = Nothing
- Set objExcelBook = Nothing
- Set objExcelApp = Nothing
- End Function
复制代码
然后是调用:
- CompareSheets "Sheet1","Sheet2",1,3,1,5,true,"D:\Test.xlsx"
复制代码
这个参数好像是从1开始计数的,参数中Start位你都写的0,也会报错吧。 |
|