Excel函数 操作ECEL 数据表格 表单 编辑ECEL 工作表.docx

Excel函数 操作ECEL 数据表格 表单 编辑ECEL 工作表Excel函数 操作EXCEL 数据表格 表单 编辑EXCEL 工作表 Dim ExcelApp 'As Excel.Application Dim excelSheet 'As Excel.worksheet Dim excelBook 'As Excel.workbook Dim fso 'As scrpting.FileSystemObject ' * ' 函数说明：创建一个Excel应用程序ExcelApp,并创建一个新的工作薄Workbook; ' 参数说明：无 ' 调用方法: ' CreateExcel ' * Function CreateExcel Dim excelSheet Set ExcelApp = CreateObject("Excel.Application") ExcelApp.Workbooks.Add ExcelApp.Visible = True Set CreateExcel = ExcelApp End Function ' * ' 函数说明：关闭Excel应用程序; ' 参数说明： ' (1)ExcelApp:Excel应用程序名称; ' 调用方法: ' CloseExcel(ExcelApp) ' * Sub CloseExcel(ExcelApp) Set excelSheet = ExcelApp.ActiveSheet Set excelBook = ExcelApp.ActiveWorkbook Set fso = CreateObject("scrpting.FileSystemObject") On Error Resume Next fso.CreateFolder "C:Temp" fso.DeleteFile "C:TempExcelExamples.xls" excelBook.SaveAs "C:TempExcelExamples.xls" ExcelApp.Quit Set ExcelApp = Nothing Set fso = Nothing Err = 0 On Error GoTo 0 End Sub ' * ' 函数说明：保存工作薄; ' 参数说明： ' (1)ExcelApp:Excel应用程序名称; ' (2)workbookIdentifier:属于ExcelApp的工作薄名称; ' (3)path:保存的路径; ' 返回结果： ' (1)保存成功，返回字符串：OK ' (2)保存失败，返回字符串：Bad Worksheet Identifier ' 调用方法: ' ret = SaveWorkbook(ExcelApp, "Book1", "D:Example1.xls") ' * Function SaveWorkbook(ExcelApp, workbookIdentifier, path) 'As String Dim workbook On Error Resume Next '启用错误处理程序 Set workbook = ExcelApp.Workbooks(workbookIdentifier) On Error GoTo 0 '禁用错误处理程序 If Not workbook Is Nothing Then If path = "" Or path = workbook.FullName Or path = workbook.Name Then workbook.Save Else Set fso = CreateObject("scrpting.FileSystemObject") '判断路径中是否已添加扩展名.xls If InStr(path, ".") = 0 Then path = path & ".xls" End If '删除路径下现有同名的文件 On Error Resume Next fso.DeleteFile path Set fso = Nothing Err = 0 On Error GoTo 0 workbook.SaveAs path End If SaveWorkbook = "OK" Else SaveWorkbook = "Bad Workbook Identifier" End If End Function ' * ' 函数说明：设置工作表excelSheet单元格的值 ' 参数说明： ' (1)excelSheet:工作表名称; ' (2)row:列的序号,第一列为1; ' (3)column:行的序号,第一行为1; ' (4)value:单元格要设置的值; ' 返回结果： ' 无返回值 ' 调用方法: ' SetCellValue excelSheet1, 1, 2, "test" ' * Sub SetCellValue(excelSheet, row, column, value) On Error Resume Next excelSheet.Cells(row, column) = value On Error GoTo 0 End Sub 'The GetCellValue returns the cell's value according to its row column and sheet 'excelSheet - the Excel Sheet in which the cell exists 'row - the cell's row 'column - the cell's column 'return 0 if the cell could not be found ' * ' 函数说明：获取工作表excelSheet单元格的值 ' 参数说明： ' (1)excelSheet:工作表名称; ' (2)row:列的序号; ' (3)column:行的序号; ' 返回结果： ' (1)单元格存在,返回单元格值; ' (2)单元格不存在，返回0; ' 调用方法: ' set CellValue = GetCellValue(excelSheet, 1, 2) ' * Function GetCellValue(excelSheet, row, column) value = 0 Err = 0 On Error Resume Next tempValue = excelSheet.Cells(row, column) If Err = 0 Then value = tempValue Err = 0 End If On Error GoTo 0 GetCellValue = value End Function ' * ' 函数说明：获取并返回工作表对象 ' 参数说明： ' (1)ExcelApp:Excel应用程序名称; ' (2)sheetIdentifier:属于ExcelApp的工作表名称; ' 返回结果： ' (1)成功：工作表对象Excel.worksheet ' (1)失败：Nothing ' 调用方法: ' Set excelSheet1 = GetSheet(ExcelApp, "Sheet Name") ' * Function GetSheet(ExcelApp, sheetIdentifier) On Error Resume Next Set GetSheet = ExcelApp.Worksheets.Item(sheetIdentifier) On Error GoTo 0 End Function ' * ' 函数说明：添加一张新的工作表 ' 参数说明： ' (1)ExcelApp:Excel应用程序名称; ' (2)workbookIdentifier:属于ExcelApp的工作薄名称; ' (2)sheetName:要插入的工作表名称; ' 返回结果： ' (1)成功：工作表对象worksheet ' (1)失败：Nothing ' 调用方法: ' InsertNewWorksheet(ExcelApp, workbookIdentifier, "new sheet") ' * Function InsertNewWorksheet(ExcelApp, workbookIdentifier, sheetName) Dim workbook 'As Excel.workbook Dim worksheet 'As Excel.worksheet '如果指定的工作薄不存在，将在当前激活状态的工作表中添加工作表 If workbookIdentifier = "" Then Set workbook = ExcelApp.ActiveWorkbook Else On Error Resume Next Err = 0 Set workbook = ExcelApp.Workbooks(workbookIdentifier) If Err <> 0 Then Set InsertNewWorksheet = Nothing Err = 0 Exit Function End If On Error GoTo 0 End If sheetCount = workbook.Sheets.Count '获取工作薄中工作表的数量 workbook.Sheets.Add , sheetCount '添加工作表 Set worksheet = workbook.Sheets(sheetCount + 1) '初始化worksheet为新添加的工作表对象 '设置新添加的工作表名称 If sheetName <> "" Then worksheet.Name = sheetName End If Set InsertNewWorksheet = worksheet End Function ' * ' 函数说明：修改工作表的名称; ' 参数说明： ' (1)ExcelApp:Excel应用程序名称; ' (2)workbookIdentifier:属于ExcelApp的工作薄名称; ' (3)worksheetIdentifier:属于workbookIdentifier工作薄的工作表名称; ' (4)sheetName:修改后的工作表名称; ' 返回结果： ' (1)修改成功，返回字符串：OK ' (2)修改失败，返回字符串：Bad Worksheet Identifier ' 调用方法: ' set ret = RenameWorksheet(ExcelApp, "Book1", "Sheet1", "Sheet Name") ' * Function RenameWorksheet(ExcelApp, workbookIdentifier, worksheetIdentifier, sheetName) Dim workbook Dim worksheet On Error Resume Next Err = 0 Set workbook = ExcelApp.Workbooks(workbookIdentifier) If Err <> 0 Then RenameWorksheet = "Bad Workbook Identifier" Err = 0 Exit Function End If Set worksheet = workbook.Sheets(worksheetIdentifier) If Err <> 0 Then RenameWorksheet = "Bad Worksheet Identifier" Err = 0 Exit Function End If worksheet.Name = sheetName RenameWorksheet = "OK" End Function ' * ' 函数说明：删除工作表; ' 参数说明： ' (1)ExcelApp:Excel应用程序名称; ' (2)workbookIdentifier:属于ExcelApp的工作薄名称; ' (3)worksheetIdentifier:属于workbookIdentifier工作薄的工作表名称; ' 返回结果： ' (1)删除成功，返回字符串：OK ' (2)删除失败，返回字符串：Bad Worksheet Identifier ' 调用方法: ' set ret = RemoveWorksheet(ExcelApp, "Book1", "Sheet1") ' * Function RemoveWorksheet(ExcelApp, workbookIdentifier, worksheetIdentifier) Dim workbook 'As Excel.workbook Dim worksheet 'As Excel.worksheet On Error Resume Next Err = 0 Set workbook = ExcelApp.Workbooks(workbookIdentifier) If Err <> 0 Then RemoveWorksheet = "Bad Workbook Identifier" Exit Function End If Set worksheet = workbook.Sheets(worksheetIdentifier) If Err <> 0 Then RemoveWorksheet = "Bad Worksheet Identifier" Exit Function End If worksheet.Delete RemoveWorksheet = "OK" End Function ' * ' 函数说明：添加新的工作薄 ' 参数说明： ' (1)ExcelApp:Excel应用程序名称; ' 返回结果： ' (1)成功：工作表对象NewWorkbook ' (1)失败：Nothing ' 调用方法: ' set NewWorkbook = CreateNewWorkbook(ExcelApp) ' * Function CreateNewWorkbook(ExcelApp) Set NewWorkbook = ExcelApp.Workbooks.Add Set CreateNewWorkbook = NewWorkbook End Function ' * ' 函数说明：打开工作薄 ' 参数说明： ' (1)ExcelApp:Excel应用程序名称; ' (2)path:要打开的工作薄路径; ' 返回结果： ' (1)成功：工作表对象NewWorkbook ' (1)失败：Nothing ' 调用方法: ' set NewWorkbook = CreateNewWorkbook(ExcelApp) ' * Function OpenWorkbook(ExcelApp, path) On Error Resume Next Set NewWorkbook = ExcelApp.Workbooks.Open(path) Set penWorkbook = NewWorkbook On Error GoTo 0 End Function ' * ' 函数说明：将工作薄设置为当前工作状态 ' 参数说明： ' (1)ExcelApp:Excel应用程序名称; ' (2)workbookIdentifier:要设置为当前工作状态的工作薄名称; ' 返回结果：无返回值; ' 调用方法: ' ActivateWorkbook(ExcelApp, workbook1) ' * Sub ActivateWorkbook(ExcelApp, workbookIdentifier) On Error Resume Next ExcelApp.Workbooks(workbookIdentifier).Activate On Error GoTo 0 End Sub ' * ' 函数说明：关闭Excel工作薄; ' 参数说明： ' (1)ExcelApp:Excel应用程序名称; ' (2)workbookIdentifier: ' 调用方法: ' CloseWorkbook(ExcelApp, workbookIdentifier) ' * Sub CloseWorkbook(ExcelApp, workbookIdentifier) On Error Resume Next ExcelApp.Workbooks(workbookIdentifier).Close On Error GoTo 0 End Sub ' * ' 函数说明：判断两个工作表对应单元格内容是否相等 ' 参数说明： ' (1)sheet1:工作表1的名称; ' (2)sheet2:工作表2的名称; ' (3)startColumn:开始比较的行序号; ' (4)numberOfColumns:要比较的行数; ' (5)startRow:开始比较的列序号; ' (6)numberOfRows:要比较的列数; ' (7)trimed:是否先除去字符串开始的空格和尾部空格后再进行比较,true或flase; ' 返回结果： ' (1)两工作表对应单元格内容相等：true ' (2)两工作表对应单元格内容不相等:flase ' 调用方法: ' ret = CompareSheets(excelSheet1, excelSheet2, 1, 10, 1, 10, False) ' * Function CompareSheets(sheet1, sheet2, startColumn, numberOfColumns, startRow, numberOfRows, trimed) Dim returnVal 'As Boolean returnVal = True '判断两个工作表是否都存在,任何一个不存在停止判断，返回flase If sheet1 Is Nothing Or sheet2 Is Nothing Then CompareSheets = False Exit Function End If '循环判断两个工作表单元格的值是否相等 For r = startRow to (startRow + (numberOfRows - 1) For c = startColumn to (startColumn + (numberOfColumns - 1) Value1 = sheet1.Cells(r, c) Value2 = sheet2.Cells(r, c) '如果trimed为true,去除单元格内容前面和尾部空格 If trimed Then Value1 = Trim(Value1) Value2 = Trim(Value2) End If '如果单元格内容不一致,函数返回flase If Value1 <> Value2 Then Dim cell 'As Excel.Range '修改sheet2工作表中对应单元格值 sheet2.Cells(r, c) = "Compare conflict - Value was '" & Value2 & "', Expected value is '" & Value1 & "'." '初始化cell为sheet2中r:c单元格对象 Set cell = sheet2.Cells(r, c) ' '将sheet2工作表中对应单元格的颜色设置为红色 cell.Font.Color = vbRed returnVal = False End If Next Next CompareSheets = returnVal End Function