Excel函数 操作EXCEL 数据表格 表单 编辑EXCEL 工作表

Excel函数操作EXCEL 数据表格表单编辑EXCEL 工作表Dim ExcelApp 'As Excel.ApplicationDim excelSheet 'As Excel.worksheetDim excelBook 'As Excel.workbookDim fso 'As scrīpting.FileSystemObject' ********************************************************************************************* ' 函数说明：创建一个Excel应用程序ExcelApp,并创建一个新的工作薄Workbook; ' 参数说明：无' 调用方法:' CreateExcel()' *********************************************************************************************Function CreateExcel()Dim excelSheetSet ExcelApp = CreateObject("Excel.Application")ExcelApp.Workbooks.AddExcelApp.Visible = TrueSet CreateExcel = ExcelAppEnd Function' ********************************************************************************************* ' 函数说明：关闭Excel应用程序;' 参数说明：' (1)ExcelApp:Excel应用程序名称;' 调用方法:' CloseExcel(ExcelApp)' ********************************************************************************************* Sub CloseExcel(ExcelApp)Set excelSheet = ExcelApp.ActiveSheetSet excelBook = ExcelApp.ActiveWorkbookSet fso = CreateObject("scrīpting.FileSystemObject")On Error Resume Nextfso.CreateFolder "C:\Temp"fso.DeleteFile "C:\Temp\ExcelExamples.xls"excelBook.SaveAs "C:\Temp\ExcelExamples.xls"ExcelApp.QuitSet ExcelApp = NothingSet fso = NothingErr = 0On Error GoTo 0End 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 workbookOn Error Resume Next '启用错误处理程序Set workbook = ExcelApp.Workbooks(workbookIdentifier)On Error GoTo 0 '禁用错误处理程序If Not workbook Is Nothing ThenIf path = "" Or path = workbook.FullName Or path = Then workbook.SaveElseSet fso = CreateObject("scrīpting.FileSyste mObject")'判断路径中是否已添加扩展名.xlsIf InStr(path, ".") = 0 Thenpath = path & ".xls"End If'删除路径下现有同名的文件On Error Resume Nextfso.DeleteFile pathSet fso = NothingErr = 0On Error GoTo 0workbook.SaveAs pathEnd IfSaveWorkbook = "OK"ElseSaveWorkbook = "Bad Workbook Identifier"End IfEnd 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 NextexcelSheet.Cells(row, column) = valueOn Error GoTo 0End 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 = 0Err = 0On Error Resume NexttempValue = excelSheet.Cells(row, column)If Err = 0 Thenvalue = tempValueErr = 0End IfOn Error GoTo 0GetCellValue = valueEnd 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 NextSet GetSheet = ExcelApp.Worksheets.Item(sheetIdentifier)On Error GoTo 0End 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.workbookDim worksheet 'As Excel.worksheet'如果指定的工作薄不存在，将在当前激活状态的工作表中添加工作表If workbookIdentifier = "" ThenSet workbook = ExcelApp.ActiveWorkbookElseOn Error Resume NextErr = 0Set workbook = ExcelApp.Workbooks(workbookIdentifier)If Err <> 0 ThenSet InsertNewWorksheet = NothingErr = 0Exit FunctionEnd IfOn Error GoTo 0End IfsheetCount = workbook.Sheets.Count '获取工作薄中工作表的数量workbook.Sheets.Add , sheetCount '添加工作表Set worksheet = workbook.Sheets(sheetCount + 1) '初始化worksheet为新添加的工作表对象'设置新添加的工作表名称If sheetName <> "" Then = sheetNameEnd IfSet InsertNewWorksheet = worksheetEnd 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 workbookDim worksheetOn Error Resume NextErr = 0Set workbook = ExcelApp.Workbooks(workbookIdentifier)If Err <> 0 ThenRenameWorksheet = "Bad Workbook Identifier"Err = 0Exit FunctionEnd IfSet worksheet = workbook.Sheets(worksheetIdentifier)If Err <> 0 ThenRenameWorksheet = "Bad Worksheet Identifier"Err = 0Exit FunctionEnd If = sheetNameRenameWorksheet = "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.workbookDim worksheet 'As Excel.worksheetOn Error Resume NextErr = 0Set workbook = ExcelApp.Workbooks(workbookIdentifier)If Err <> 0 ThenRemoveWorksheet = "Bad Workbook Identifier"Exit FunctionSet worksheet = workbook.Sheets(worksheetIdentifier)If Err <> 0 ThenRemoveWorksheet = "Bad Worksheet Identifier"Exit FunctionEnd Ifworksheet.DeleteRemoveWorksheet = "OK"End Function' ********************************************************************************************* ' 函数说明：添加新的工作薄' 参数说明：' (1)ExcelApp:Excel应用程序名称;' 返回结果：' (1)成功：工作表对象NewWorkbook' (1)失败：Nothing' 调用方法:' set NewWorkbook = CreateNewWorkbook(ExcelApp)' *********************************************************************************************Function CreateNewWorkbook(ExcelApp)Set NewWorkbook = ExcelApp.Workbooks.Add()Set CreateNewWorkbook = NewWorkbookEnd Function' ********************************************************************************************* ' 函数说明：打开工作薄' 参数说明：' (1)ExcelApp:Excel应用程序名称;' (2)path:要打开的工作薄路径;' 返回结果：' (1)成功：工作表对象NewWorkbook' (1)失败：Nothing' 调用方法:' set NewWorkbook = CreateNewWorkbook(ExcelApp)' *********************************************************************************************Function OpenWorkbook(ExcelApp, path)On Error Resume NextSet NewWorkbook = ExcelApp.Workbooks.Open(path)Set ōpenWorkbook = NewWorkbookOn Error GoTo 0' ********************************************************************************************* ' 函数说明：将工作薄设置为当前工作状态' 参数说明：' (1)ExcelApp:Excel应用程序名称;' (2)workbookIdentifier:要设置为当前工作状态的工作薄名称;' 返回结果：无返回值;' 调用方法:' ActivateWorkbook(ExcelApp, workbook1)' *********************************************************************************************Sub ActivateWorkbook(ExcelApp, workbookIdentifier)On Error Resume NextExcelApp.Workbooks(workbookIdentifier).ActivateOn Error GoTo 0End Sub' ********************************************************************************************* ' 函数说明：关闭Excel工作薄;' 参数说明：' (1)ExcelApp:Excel应用程序名称;' (2)workbookIdentifier:' 调用方法:' CloseWorkbook(ExcelApp, workbookIdentifier)' *********************************************************************************************Sub CloseWorkbook(ExcelApp, workbookIdentifier)On Error Resume NextExcelApp.Workbooks(workbookIdentifier).CloseOn Error GoTo 0End 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 BooleanreturnVal = True'判断两个工作表是否都存在,任何一个不存在停止判断，返回flaseIf sheet1 Is Nothing Or sheet2 Is Nothing ThenCompareSheets = FalseExit FunctionEnd 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 ThenValue1 = Trim(Value1)Value2 = Trim(Value2)End If'如果单元格内容不一致,函数返回flaseIf Value1 <> Value2 ThenDim 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 = vbRedreturnVal = FalseEnd IfNextNextCompareSheets = returnVal End Function。