1: QTP Excel函數 操作EXCEL 數據表格 表單 編輯EXCEL 工作表 2: Dim ExcelApp 'As Excel.Application 3: Dim excelSheet 'As Excel.worksheet 4: Dim excelBook 'As Excel.workbook 5: Dim fso 'As scrīpting.FileSystemObject 6: ? 7: ' ********************************************************************************************* 8: ' 函數說明：創建一個Excel應用程序ExcelApp,并創建一個新的工作薄Workbook; 9: ' 參數說明：無 10: ' 調用方法: 11: ' CreateExcel() 12: ' ********************************************************************************************* 13: ? 14: Function CreateExcel() 15: Dim excelSheet 16: Set ExcelApp = CreateObject("Excel.Application") 17: ExcelApp.Workbooks.Add 18: ExcelApp.Visible = True 19: Set CreateExcel = ExcelApp 20: End Function 21: ? 22: ' ********************************************************************************************* 23: ' 函數說明：關閉Excel應用程序; 24: ' 參數說明： 25: ' (1)ExcelApp:Excel應用程序名稱; 26: ' 調用方法: 27: ' CloseExcel(ExcelApp) 28: ' ********************************************************************************************* 29: Sub CloseExcel(ExcelApp) 30: Set excelSheet = ExcelApp.ActiveSheet 31: Set excelBook = ExcelApp.ActiveWorkbook 32: Set fso = CreateObject("scrīpting.FileSystemObject") 33: On Error Resume Next 34: fso.CreateFolder "C:\Temp" 35: fso.DeleteFile "C:\Temp\ExcelExamples.xls" 36: excelBook.SaveAs "C:\Temp\ExcelExamples.xls" 37: ExcelApp.Quit 38: Set ExcelApp = Nothing 39: Set fso = Nothing 40: Err = 0 41: On Error GoTo 0 42: End Sub 43: ? 44: ' ********************************************************************************************* 45: ' 函數說明：保存工作薄; 46: ' 參數說明： 47: ' (1)ExcelApp:Excel應用程序名稱; 48: ' (2)workbookIdentifier:屬于ExcelApp的工作薄名稱; 49: ' (3)path:保存的路徑; 50: ' 返回結果： 51: ' (1)保存成功，返回字符串：OK 52: ' (2)保存失敗，返回字符串：Bad Worksheet Identifier 53: ' 調用方法: 54: ' ret = SaveWorkbook(ExcelApp, "Book1", "D:\Example1.xls") 55: ' ********************************************************************************************* 56: ? 57: Function SaveWorkbook(ExcelApp, workbookIdentifier, path) 'As String 58: Dim workbook 59: On Error Resume Next '啟用錯誤處理程序 60: Set workbook = ExcelApp.Workbooks(workbookIdentifier) 61: On Error GoTo 0 '禁用錯誤處理程序 62: ? 63: If Not workbook Is Nothing Then 64: If path = "" Or path = workbook.FullName Or path = workbook.Name Then 65: workbook.Save 66: Else 67: Set fso = CreateObject("scrīpting.FileSystemObject") 68: ? 69: '判斷路徑中是否已添加擴展名.xls 70: If InStr(path, ".") = 0 Then 71: path = path & ".xls" 72: End If 73: ? 74: '刪除路徑下現有同名的文件 75: On Error Resume Next 76: fso.DeleteFile path 77: Set fso = Nothing 78: Err = 0 79: On Error GoTo 0 80: 81: workbook.SaveAs path 82: End If 83: SaveWorkbook = "OK" 84: Else 85: SaveWorkbook = "Bad Workbook Identifier" 86: End If 87: End Function 88: ? 89: ' ********************************************************************************************* 90: ' 函數說明：設置工作表excelSheet單元格的值 91: ' 參數說明： 92: ' (1)excelSheet:工作表名稱; 93: ' (2)row:列的序號,第一列為1; 94: ' (3)column:行的序號,第一行為1; 95: ' (4)value:單元格要設置的值; 96: ' 返回結果： 97: ' 無返回值 98: ' 調用方法: 99: ' SetCellValue excelSheet1, 1, 2, "test" 100: ' ********************************************************************************************* 101: ? 102: Sub SetCellValue(excelSheet, row, column, value) 103: On Error Resume Next 104: excelSheet.Cells(row, column) = value 105: On Error GoTo 0 106: End Sub 107: ? 108: 'The GetCellValue returns the cell's value according to its row column and sheet 109: 'excelSheet - the Excel Sheet in which the cell exists 110: 'row - the cell's row 111: 'column - the cell's column 112: 'return 0 if the cell could not be found 113: ' ********************************************************************************************* 114: ' 函數說明：獲取工作表excelSheet單元格的值 115: ' 參數說明： 116: ' (1)excelSheet:工作表名稱; 117: ' (2)row:列的序號; 118: ' (3)column:行的序號; 119: ' 返回結果： 120: ' (1)單元格存在,返回單元格值; 121: ' (2)單元格不存在，返回0; 122: ' 調用方法: 123: ' set CellValue = GetCellValue(excelSheet, 1, 2) 124: ' ********************************************************************************************* 125: ? 126: Function GetCellValue(excelSheet, row, column) 127: value = 0 128: Err = 0 129: On Error Resume Next 130: tempValue = excelSheet.Cells(row, column) 131: If Err = 0 Then 132: value = tempValue 133: Err = 0 134: End If 135: On Error GoTo 0 136: GetCellValue = value 137: End Function 138: ? 139: ' ********************************************************************************************* 140: ' 函數說明：獲取并返回工作表對象 141: ' 參數說明： 142: ' (1)ExcelApp:Excel應用程序名稱; 143: ' (2)sheetIdentifier:屬于ExcelApp的工作表名稱; 144: ' 返回結果： 145: ' (1)成功：工作表對象Excel.worksheet 146: ' (1)失敗：Nothing 147: ' 調用方法: 148: ' Set excelSheet1 = GetSheet(ExcelApp, "Sheet Name") 149: ' ********************************************************************************************* 150: ? 151: Function GetSheet(ExcelApp, sheetIdentifier) 152: On Error Resume Next 153: Set GetSheet = ExcelApp.Worksheets.Item(sheetIdentifier) 154: On Error GoTo 0 155: End Function 156: ? 157: ' ********************************************************************************************* 158: ' 函數說明：添加一張新的工作表 159: ' 參數說明： 160: ' (1)ExcelApp:Excel應用程序名稱; 161: ' (2)workbookIdentifier:屬于ExcelApp的工作薄名稱; 162: ' (2)sheetName:要插入的工作表名稱; 163: ' 返回結果： 164: ' (1)成功：工作表對象worksheet 165: ' (1)失敗：Nothing 166: ' 調用方法: 167: ' InsertNewWorksheet(ExcelApp, workbookIdentifier, "new sheet") 168: ' ********************************************************************************************* 169: ? 170: Function InsertNewWorksheet(ExcelApp, workbookIdentifier, sheetName) 171: Dim workbook 'As Excel.workbook 172: Dim worksheet 'As Excel.worksheet 173: ? 174: '如果指定的工作薄不存在，將在當前激活狀態的工作表中添加工作表 175: If workbookIdentifier = "" Then 176: Set workbook = ExcelApp.ActiveWorkbook 177: Else 178: On Error Resume Next 179: Err = 0 180: Set workbook = ExcelApp.Workbooks(workbookIdentifier) 181: If Err <> 0 Then 182: Set InsertNewWorksheet = Nothing 183: Err = 0 184: Exit Function 185: End If 186: On Error GoTo 0 187: End If 188: ? 189: sheetCount = workbook.Sheets.Count '獲取工作薄中工作表的數量 190: workbook.Sheets.Add , sheetCount '添加工作表 191: Set worksheet = workbook.Sheets(sheetCount + 1) '初始化worksheet為新添加的工作表對象 192: ? 193: '設置新添加的工作表名稱 194: If sheetName <> "" Then 195: worksheet.Name = sheetName 196: End If 197: ? 198: Set InsertNewWorksheet = worksheet 199: End Function 200: ? 201: ' ********************************************************************************************* 202: ' 函數說明：修改工作表的名稱; 203: ' 參數說明： 204: ' (1)ExcelApp:Excel應用程序名稱; 205: ' (2)workbookIdentifier:屬于ExcelApp的工作薄名稱; 206: ' (3)worksheetIdentifier:屬于workbookIdentifier工作薄的工作表名稱; 207: ' (4)sheetName:修改后的工作表名稱; 208: ' 返回結果： 209: ' (1)修改成功，返回字符串：OK 210: ' (2)修改失敗，返回字符串：Bad Worksheet Identifier 211: ' 調用方法: 212: ' set ret = RenameWorksheet(ExcelApp, "Book1", "Sheet1", "Sheet Name") 213: ' ********************************************************************************************* 214: ? 215: Function RenameWorksheet(ExcelApp, workbookIdentifier, worksheetIdentifier, sheetName) 216: Dim workbook 217: Dim worksheet 218: On Error Resume Next 219: Err = 0 220: Set workbook = ExcelApp.Workbooks(workbookIdentifier) 221: If Err <> 0 Then 222: RenameWorksheet = "Bad Workbook Identifier" 223: Err = 0 224: Exit Function 225: End If 226: Set worksheet = workbook.Sheets(worksheetIdentifier) 227: If Err <> 0 Then 228: RenameWorksheet = "Bad Worksheet Identifier" 229: Err = 0 230: Exit Function 231: End If 232: worksheet.Name = sheetName 233: RenameWorksheet = "OK" 234: End Function 235: ? 236: ' ********************************************************************************************* 237: ' 函數說明：刪除工作表; 238: ' 參數說明： 239: ' (1)ExcelApp:Excel應用程序名稱; 240: ' (2)workbookIdentifier:屬于ExcelApp的工作薄名稱; 241: ' (3)worksheetIdentifier:屬于workbookIdentifier工作薄的工作表名稱; 242: ' 返回結果： 243: ' (1)刪除成功，返回字符串：OK 244: ' (2)刪除失敗，返回字符串：Bad Worksheet Identifier 245: ' 調用方法: 246: ' set ret = RemoveWorksheet(ExcelApp, "Book1", "Sheet1") 247: ' ********************************************************************************************* 248: ? 249: Function RemoveWorksheet(ExcelApp, workbookIdentifier, worksheetIdentifier) 250: Dim workbook 'As Excel.workbook 251: Dim worksheet 'As Excel.worksheet 252: On Error Resume Next 253: Err = 0 254: Set workbook = ExcelApp.Workbooks(workbookIdentifier) 255: If Err <> 0 Then 256: RemoveWorksheet = "Bad Workbook Identifier" 257: Exit Function 258: End If 259: Set worksheet = workbook.Sheets(worksheetIdentifier) 260: If Err <> 0 Then 261: RemoveWorksheet = "Bad Worksheet Identifier" 262: Exit Function 263: End If 264: worksheet.Delete 265: RemoveWorksheet = "OK" 266: End Function 267: ? 268: ' ********************************************************************************************* 269: ' 函數說明：添加新的工作薄 270: ' 參數說明： 271: ' (1)ExcelApp:Excel應用程序名稱; 272: ' 返回結果： 273: ' (1)成功：工作表對象NewWorkbook 274: ' (1)失敗：Nothing 275: ' 調用方法: 276: ' set NewWorkbook = CreateNewWorkbook(ExcelApp) 277: ' ********************************************************************************************* 278: ? 279: Function CreateNewWorkbook(ExcelApp) 280: Set NewWorkbook = ExcelApp.Workbooks.Add() 281: Set CreateNewWorkbook = NewWorkbook 282: End Function 283: ? 284: ' ********************************************************************************************* 285: ' 函數說明：打開工作薄 286: ' 參數說明： 287: ' (1)ExcelApp:Excel應用程序名稱; 288: ' (2)path:要打開的工作薄路徑; 289: ' 返回結果： 290: ' (1)成功：工作表對象NewWorkbook 291: ' (1)失敗：Nothing 292: ' 調用方法: 293: ' set NewWorkbook = CreateNewWorkbook(ExcelApp) 294: ' ********************************************************************************************* 295: ? 296: Function OpenWorkbook(ExcelApp, path) 297: On Error Resume Next 298: Set NewWorkbook = ExcelApp.Workbooks.Open(path) 299: Set ōpenWorkbook = NewWorkbook 300: On Error GoTo 0 301: End Function 302: ? 303: ' ********************************************************************************************* 304: ' 函數說明：將工作薄設置為當前工作狀態 305: ' 參數說明： 306: ' (1)ExcelApp:Excel應用程序名稱; 307: ' (2)workbookIdentifier:要設置為當前工作狀態的工作薄名稱; 308: ' 返回結果：無返回值; 309: ' 調用方法: 310: ' ActivateWorkbook(ExcelApp, workbook1) 311: ' ********************************************************************************************* 312: ? 313: Sub ActivateWorkbook(ExcelApp, workbookIdentifier) 314: On Error Resume Next 315: ExcelApp.Workbooks(workbookIdentifier).Activate 316: On Error GoTo 0 317: End Sub 318: ? 319: ' ********************************************************************************************* 320: ' 函數說明：關閉Excel工作薄; 321: ' 參數說明： 322: ' (1)ExcelApp:Excel應用程序名稱; 323: ' (2)workbookIdentifier: 324: ' 調用方法: 325: ' CloseWorkbook(ExcelApp, workbookIdentifier) 326: ' ********************************************************************************************* 327: ? 328: Sub CloseWorkbook(ExcelApp, workbookIdentifier) 329: On Error Resume Next 330: ExcelApp.Workbooks(workbookIdentifier).Close 331: On Error GoTo 0 332: End Sub 333: ? 334: ' ********************************************************************************************* 335: ' 函數說明：判斷兩個工作表對應單元格內容是否相等 336: ' 參數說明： 337: ' (1)sheet1:工作表1的名稱; 338: ' (2)sheet2:工作表2的名稱; 339: ' (3)startColumn:開始比較的行序號; 340: ' (4)numberOfColumns:要比較的行數; 341: ' (5)startRow:開始比較的列序號; 342: ' (6)numberOfRows:要比較的列數; 343: ' (7)trimed:是否先除去字符串開始的空格和尾部空格后再進行比較,true或flase; 344: ' 返回結果： 345: ' (1)兩工作表對應單元格內容相等：true 346: ' (2)兩工作表對應單元格內容不相等:flase 347: ' 調用方法: 348: ' ret = CompareSheets(excelSheet1, excelSheet2, 1, 10, 1, 10, False) 349: ' ********************************************************************************************* 350: ? 351: Function CompareSheets(sheet1, sheet2, startColumn, numberOfColumns, startRow, numberOfRows, trimed) 352: Dim returnVal 'As Boolean 353: returnVal = True 354: ? 355: '判斷兩個工作表是否都存在,任何一個不存在停止判斷，返回flase 356: If sheet1 Is Nothing Or sheet2 Is Nothing Then 357: CompareSheets = False 358: Exit Function 359: End If 360: ? 361: '循環判斷兩個工作表單元格的值是否相等 362: For r = startRow to (startRow + (numberOfRows - 1)) 363: For c = startColumn to (startColumn + (numberOfColumns - 1)) 364: Value1 = sheet1.Cells(r, c) 365: Value2 = sheet2.Cells(r, c) 366: ? 367: '如果trimed為true,去除單元格內容前面和尾部空格 368: If trimed Then 369: Value1 = Trim(Value1) 370: Value2 = Trim(Value2) 371: End If 372: ? 373: '如果單元格內容不一致,函數返回flase 374: If Value1 <> Value2 Then 375: Dim cell 'As Excel.Range 376: '修改sheet2工作表中對應單元格值 377: sheet2.Cells(r, c) = "Compare conflict - Value was '" & Value2 & "', Expected value is '" & Value1 & "'." 378: '初始化cell為sheet2中r:c單元格對象 379: Set cell = sheet2.Cells(r, c) ' 380: '將sheet2工作表中對應單元格的顏色設置為紅色 381: cell.Font.Color = vbRed 382: returnVal = False 383: End If 384: Next 385: Next 386: CompareSheets = returnVal 387: End Function

388: ?

本文轉自hcy's workbench博客園博客，原文鏈接：http://www.cnblogs.com/alterhu/archive/2011/12/29/2306014.html，如需轉載請自行聯系原作者。

總結

以上是生活随笔為你收集整理的QTP的那些事--操作excel的函数的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。