4.3.1 Workbook对象是Workbooks集合中的一个成员2. 怎样引用集合中的某个工作簿法一：使用索引号引用工作簿要引用Workbooks集合中的第3个Workbook，可以将代码写为：Workbooks.Item(3)使用时可以省略属性名称Item，将代码写为：Workbooks(3)法二：利用工作簿名引用工作簿Workbooks("Book1")Workbooks("Book1.xlsm")? Workbooks("Book1").Name? Workbooks("Book1.xlsm").Name4.3.2 访问对象的属性，获得工作簿文件的信息Sub WbMsg() Range("B2") = ThisWorkbook.Name Range("B3") = ThisWorkbook.Path Range("B4") = ThisWorkbook.FullNameEnd Sub4.3.3 用Add方法创建工作簿Workbooks.AddWorkbooks.Add Template:="D:\我的文件\模板.xlsm"Workbooks.Add "D:\我的文件\模板.xlsm"4.3.4 用Open方法打开工作薄Workbooks.Open Filename:="D:\我的文件\模板.xlsm"Workbooks.Open "D:\我的文件\模板.xlsm"4.3.5 用Activate方法激活工作簿虽然可以同时打开多个工作簿文件，但同一时间只能有一个工作簿是活动的。如果想让不活动的工作簿变为活动的工作簿，可以用Workbooks对象的Activate方法激活它，例如：Workbooks("工作簿1").Activate4.3.8 ThisWorkbook与ActiveWorkbookThisWorkbook 和 ActivateWorkbook 都是Application对象的属性，都返回Workbook对象。但是，它们之间并不是等同的。ThisWorkbook是对代码所在的工作簿的引用，ActiveWorkbook是对活动工作簿的引用。Sub wb() Workbooks.Add MsgBox "代码所在的工作簿为：" & ThisWorkbook.Name MsgBox "当前活动工作簿为：" & ActiveWorkbook.Name ActiveWorkbook.Close savechanges:=FalseEnd Sub4.4 操作工作表，认识Worksheet对象4.4.1 引用工作表的3种方法Worksheets.Item(3) '引用工作簿中的第3张工作表Worksheets(3) '引用工作簿中的第3张工作表Worksheets("ExcelHome") '引用工作簿中标签名称为"ExcelHome"的工作表与使用索引号或标签名称引用工作表不同，使用代码名称引用工作表，只需直接写代码名称而不需先写集合名称Worksheets，例如：Sheet3.Range("A1")=100 '在代码名称为sheet3的工作表的A1单元格输入100注意Range("A1")与Range("A1").Value的区别Range("A1").Value = 700Range("A1") = 700如果想获得某张工作表的代码名称，可以访问工作表的CodeName属性，例如：MsgBox ActiveSheet.CodeName '用对话框显示活动工作表的代码名称4.5 操作的核心，至关重要的Range对象4.5.1 用Range属性引用单元格1. 引用单个固定的单元格区域Sub rng() Range("A1:A10").Value = 200 '在活动工作表的A1:A10输入数值200 Dim n As String n = "B1:B10" Range(n) = 100 '在当前活动工作表的B1:B10输入数值100End Sub要引用定义为名称的单元格，可以将Range属性的参数设置为表示名称名的字符串或变量，例如：Range("C_Date").Value = 1002. 引用多个不连续的单元格区域Range("A1:A10,A4:E6,C3:D9").Select '选中多个不连续的单元格区域3. 引用多个区域的公共区域Range("B1:B10 A4:D6").Value = 100 '在两个单元格区域的公共区间输入100'尽管中间有空格，但参数只是一个字符串4. 引用两个区域围成的矩形区域Range("B6:B10","D2:D8").Select '两个参数间用逗号分隔插入一列Columns(4).Resize(, 1).Insert Shift:=xlToRightColumns("A:A").Insert Shift:=xlToRightRange("C1").SelectActiveSheet.Rows(Selection.Row).InsertActiveSheet.Columns(Selection.Column).InsertRange("C1").SelectSelection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAboveSelection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove '插入一整行 ，单元格的移动方向向下，插入的行格式随上面行的格式4.5.2 用Cells属性引用单元格1. 引用工作表中指定行列交叉的单元格ActiveSheet.Cells(3, 4).Value = 20ActiveSheet.Cells(3, "D").Value = 20在使用Cells引用工作表中的某个单元格时，总是可以将代码写为：工作表对象.Cells(行号, 列标)2. 引用单元格区域中的某个单元格Range("B3:F9").Cells(2,3) = 100 '在B3:F9区域的第2行与第3列交叉的单元格中输入1003. 将Cells属性的返回结果设置为Range属性的参数还可以将Cells属性设置为Range属性的参数，例如：Range(Cells(1, 1), Cells(10, 5)).Select '选中当前工作表的A1:E10单元格这行代码和下面的两行代码是等效的Range("A1", "E10").SelectRange(Range("A1"), Range("E10")).Select4. 使用索引号引用单元格Cells是工作表中所有单元格组成的集合，可以使用索引号引用该集合中的某个单元格，例如：ActiveSheet.Cells(2).Value = 200 '在活动工作表的第二个单元格输入2004.5.3 引用单元格，更简短的快捷方式[B2] 'B2单元格[A1:D10] 'A1:D10单元格区域[A1:A10,C1:C10,E1:E10] '三个单元格区域的并集[B1:B10 A5:D5] '两个单元格区域的公共部分[n] '被定义为名称n的单元格区域4.5.4 引用整行单元格ActiveSheet.Rows("3:3").Select '选中活动工作表的第3行ActiveSheet.Rows("3:5").Select '选中活动工作表的第3行到第5行'Rows返回其父对象(ActiveSheet)中所有行组成的集合，参数是表示行的名称的字符串或字符串变量如果使用索引号引用整行，代码为：ActiveSheet.Rows(3).Select '选中活动工作表中的第3行'3是索引号，表示引用父对象(ActiveSheet)中的第3行如果要引用工作表中的所有行，代码为：ActiveSheet.Rows.Select '选中活动工作表中的所有行'如果不给Rows属性设置参数，则表示引用集合中的所有行，效果等同于 ActiveSheet.Cells如果引用Range对象的Rows属性，则返回单元格区域中的指定行，例如：Rows("3:10").Rows("1:1").Select4.5.5 引用整列单元格ActiveSheet.Column("F:G").Select '选中活动工作表中的F到G列ActiveSheet.Columns(6).Select '选中活动工作表中的第6列ActiveSheet.Columns.Select '选中活动工作表中的所有列Columns("B:G").Columns("B:B").Select '选中B:G列区域中的第2列4.5.6 用Union方法合并多个单元格区域Application.Union(Range("A1:A10"), Range("D1:D5")).Select '同时选中两个区域试题：选中活动工作表A1:A10单元格区域中与A1单元格内容相同的所有单元格。Sub Sel() Dim myrange As Range, n As Range Set myrange = Range("A1") For Each n In Range("A1:A10") If n.Value=Range("A1").Value Then Set myrange = Union(myrange,n) End if Next n myrange.SelectEnd Sub4.5.7 Range对象的Offset属性Range对象的Offset属性，作用类似工作表中的Offset函数。使用Offset属性，可以获得相对于指定单元格区域一定偏移量位置上的单元格区域。例如：Range("A1").Offset(4, 0).Value = 500 '在A1下方的第4个单元格中输入数值500'Offset通过括号中的两个参数确定要返回的单元格Offset属性有两个参数，分别用来设置该属性的父对象在上下或左右方向上偏移的行列数，例如：Range("B2:C3").Offset(5, 3).Value = 500Range("D7:F8").Offset(-5, -2).Value = 5004.5.8 Range对象的Resize属性使用Range对象的Resize属性可以将指定的单元格区域有目的地扩大或缩小，得到一个新的单元格区域，例如：Range("B2").Resize(5, 4).Select '将B2扩展为一个5行4列的单元格区域'Resize属性把该对象最左上角的单元格当成返回结果最左上角的第1个单元格'Resize属性的参数用来确定返回区域的行数和列数，第1参数用于确定行数，第2参数用于确定列数，两个参数都应设置为正整数。4.5.9 Worksheet对象的UsedRange属性Worksheet对象的UsedRange属性返回工作表中已经使用的单元格围成的矩形区域，无论这些区域中间是否存在空行、空列或空单元格。ActiveSheet.UsedRange.Select '选中活动工作表中已经使用的单元格区域4.5.10 Range对象的CurrentRegion属性Range对象的CurrentRegion属性返回包含指定单元格在内的一个连续的矩形区域Range("B5").CurrentRegion.Select '等同于在选中B5单元格的同时，按【F5】键，定位【当前区域】得到的单元格区域。空行及下面的区域，以及空列及右边的区域不包含在CurrentRegion属性返回的区域中。4.5.11 Range对象的End属性Range对象的End属性返回包含指定单元格的区域最尾端的单元格，返回结果等同于在单元格中按【End+方向键】组合键得到的单元格。MsgBox Range("C5").End(xlUp).Address '用对话框显示End属性返回单元格的地址'参数xlUp告诉VBA，End属性返回的时区域中最上方的单元格'End属性返回的是在C5单元格中，按【End+上方向键】组合键得到的单元格其他可设置的参数xlToLeftxlToRightxlUpxlDown当使用程序向一张工作表中添加数据时，我们希望将数据添加到工作表的第1个空单元格中。要让程序往单元格中录入数据，首先得确定第1个空单元格是哪个单元格，End属性就可以解决这一问题ActiveSheet.Range("A1048576").End(xlUp).Offset(1,0).Value = "刘伟"'在A列最后一个单元格按【End+上方向键】组合键，即可得到A列最后一个非空单元格'最后一个非空单元格向下偏移一行，即可得到第一个空单元格，该单元格即为要输入数据的单元格'有一点需要注意，如果A列全为空单元格，那Range("A1048576").End(xlUp)返回的是A1单元格，同样的代码实际上是在A2单元格输入数据。要解决这一问题，可以在单元格中输入数据前，使用If语句判断End属性返回的结果是否为空单元格，再根据判断结果选择应该在哪个单元格输入数据。Option ExplicitSub RngEnd_2() Dim c As Range Set c = ActiveSheet.Range("A1048576").End(xlUp) If c.Value <> "" Then c.Offset(1, 0).Value = "刘伟" Else c.Value = "刘伟" End IfEnd Sub4.5.12 单元格中的内容：Value属性Range("A1:B2").Value = "abc" '在A1:B2中输入abcRange("B1").Value = Range("A1").Value '把A1单元格中的数据写入B1单元格中Value是Range对象的默认属性，在给区域赋值时，可以省略属性名称，将代码写为：Range("A1:B2") = "abc" '在A1:B2单元格中输入abc4.5.13 访问Count属性，获得区域中包含的单元格个数Range对象的Count属性返回指定单元格区域中包含的单元格个数，如果想知道B4:F10单元格区域一共有多少个单元格，可以用代码：Range("B4:F10").Count如果想知道某个区域包含的行数或列数，可以用代码ActiveSheet.UsedRange.Rows.Count '活动工作表中已使用区域包含的行数ActiveSheet.UsedRange.Columns.Count '活动工作表中已使用区域包含的列数4.5.14 通过Address属性获得单元格的地址想知道某个单元格的地址，可以访问它的Address属性，例如：MsgBox "当前选中的单元格地址为：" & Selection.Address4.5.15 用Activate与Select方法选中单元格要选中一个单元格区域，可以使用Range对象的Activate方法和Select方法，例如：ActiveSheet.Range("A1:F5").Activate '选中活动工作表中的A1:F5ActiveSheet.Range("A1:F5").Select '选中活动工作表中的A1:F54.5.16 选择清除单元格中的信息'清除B2单元格中所有的信息(包括批注、内容、格式、超链接等)Range("B2").Clear'清除B2单元格中的批注Range("B2").ClearComments'清除B2单元格中的内容Range("B2").ClearContents'清除B2单元格中的格式Range("B2").ClearFormats'清除B2单元格中的超链接Range("B2").ClearHyperlinks4.5.17 用Copy方法复制单元格区域录制宏示例：Sub CopyTest() Range("A1").Select Selection.Copy Range("C1").Select ActiveSheet.PasteEnd Sub该录制宏代码有冗余，在使用VBA代码复制单元格时，并不需要选中单元格，所以如果要将A1单元格复制到C1单元格，可用如下代码：Range("A1").Copy Range("C1")其中Range("C1")是Copy方法的参数(省略了参数名)，用来指定目标单元格。未省略参数名称的语句应为：Range("A1").Copy Destination:=Range("C1")综上，一个复制单元格的语句，总是可以写成这样的结构：原单元格区域.Copy Destination:=目标单元格其中参数名称Destination可以省略有一点需要说明，无论复制的区域包含多少个单元格，在设置目标区域时，都可以只指定一个单元格作为目标区域最左上角的单元格即可例如：Range("A1").CurrentRegion.Copy Destination:=Range("G1")怎样只粘贴区域中的数值而不带格式等其他内容？Sub CopyValues() Range("A1:D10").Copy Range("F1:I10").PasteSpecial Paste:=xlPasteValuesEnd Sub或Sub CopyValues() Range("F1:I10").Value = Range("A1:D10").ValueEnd Sub4.5.18 用Cut方法剪切单元格使用Cut方法可以将一个单元格区域剪切到另一个单元格区域。剪切单元格和复制单元格，除方法名称不同外，其他基本相似。Range("A1:E5").Cut Destination:=Range("G1") '把A1:E5剪切到G1：K5Range("A1").Cut Range("G1") '把A1剪切到G14.5.19 用Delete方法删除指定的单元格删除B3所在的整行单元格Range("B3").EntireRow.Delete删除B5单元格，删除后右侧单元格左移Range("B5").Delete Shift:=xlToLeft删除B5单元格，删除后下方单元格上移Range("B5").Delete Shift:=xlUp删除B5单元格所在的行Range("B5").EntireRow.Delete删除B5单元格所在的列Range("B5").EntireColumn.Delete注意：如果不使用参数，将删除单元格的代码直接写为：Range("B5").Delete执行代码删除单元格后，将把下方单元格上移，功能等同于代码：Range("B5").Delete Shift:=xlUp4.6 项目示例4.6.1 根据需求创建工作簿Sub WbAdd() '程序创建"员工花名册.xlsx"工作簿，保存到本文件所在的目录中。 Dim Wb As Workbook, sht As Worksheet Set Wb = Workbooks.Add '新建一个工作簿，并将其赋给变量Wb Set sht = Wb.Worksheets(1) With sht .Name = "花名册" '修改第一张工作表的标签名称 '设置表头 .Range("A1:F1") = Array("序号", "姓名", "性别", "出生年月", "参加工作时间", "备注") End With Wb.SaveAs ThisWorkbook.Path & "\员工花名册.xlsx" '保存新建的工作簿到指定目录中 ActiveWorkbook.Close '关闭新建的工作簿End Sub4.6.2 判断某个工作簿是否已经打开打开的工作簿很多，要判断名为“成绩表.xlsx”的工作簿是否已经打开，程序可以这样写：Sub IsOpen() '判断名称为“成绩表.xlsx”的工作薄文件是否已经打开。 Dim i As Integer For i = 1 To Workbooks.Count If Workbooks(i).Name = "成绩表.xlsx" Then '判断工作薄是否打开 MsgBox "文件已打开！" Exit Sub '如果找到该文件，退出过程 End If Next MsgBox "文件没有打开！"End Sub例2判断当前活动工作簿中是否存在标签名称为“一年级”的工作表。如果工作簿中没有这张工作表，就在所有工作表之前新建一张标签名称为“一年级”的工作表，如果工作表已存在，将其移动到所有工作表之前。Sub ShtTest() Dim sht As Worksheet For Each sht In Worksheets If sht.Name = "一年级" Then sht.Move before := Worksheets(1) Exit Sub End If Next Worksheets.Add(before := Worksheets(1)).Name = "一年级"End Sub或Sub ShtTest() On Error Resume Next If Worksheets("一年级") Is Nothing Then Worksheets.Add(before := Worksheets(1)).Name = "一年级" Else Worksheets("一年级").Move before := Worksheets(1) End IfEnd Sub4.6.3 判断文件夹是否存在指定名称的工作簿文件Sub TestFile() '判断指定目录中是否存在名为“员工花名册.xlsx”工作薄文件。 Dim fil As String fil = ThisWorkbook.Path & "\员工花名册.xlsx" '将要判断的文件名及路径保存到变量fil中 If Len(Dir(fil)) > 0 Then '用Dir函数指定目录中的文件是否存在 MsgBox "工作薄已存在!" Else MsgBox "工作薄不存在!" End IfEnd Sub4.6.4 向未打开的工作簿中输入数据一个Excel的工作簿文件，只有在打开的时候，才能在其中输入数据。如果想在一个未打开的工作簿中输入数据，可以利用VBA将文件打开，待输入完数据后，再将其保存并关闭。Sub WbInput() '在当前文件所在目录中的“员工花名册.xlsx”工作簿中里添加一条记录!" Dim wb As String, xrow As Integer, arr wb = ThisWorkbook.Path & "\员工花名册.xlsx" '指定输入数据的工作簿文件 Workbooks.Open (wb) '打开要输入数据的工作簿 With ActiveWorkbook.Worksheets(1) '向工作簿里的第1张表里添加记录 xrow = .Range("A1").CurrentRegion.Rows.Count + 1 '取得表格中第一条空行号 '将需要增加的职工信息保存在数组arr里 arr = Array(xrow - 1, "马军", "男", #7/8/1987#, #9/1/2010#, "10年新招") '将要录入工作表的数据保存在数组中 .Cells(xrow, 1).Resize(1, 6) = arr '将数组写入单元格区域 End With ActiveWorkbook.Close savechanges:=True '关闭工作薄，并保存修改End Sub如果文件夹中有“员工花名册.xlsx”这个工作簿文件，执行这个程序后，Excel就会自动在原表格的后面增加一条记录。4.6.5 隐藏活动工作表外的所有工作表可以通过设置工作表的Visible属性隐藏或取消隐藏指定的工作表。Sub ShtVisible() '隐藏活动工作表外的所有工作表 Dim sht As Worksheet For Each sht In Worksheets '循环处理Worksheets集合中的每个对象 If sht.Name <> ActiveSheet.Name Then sht.Visible = xlSheetVeryHidden '深度隐藏工作表 End If NextEnd Sub例2 将工作簿中所有的工作表都取消隐藏Sub ShowAllSheets() Dim sht As Worksheet For Each sht In Worksheets sht.Visible = True NextEnd Sub4.6.6 批量新建指定名称的工作表Sub ShtAdd() '以"数据"工作表A列中的信息来新建不同名称的工作表 Dim i As Integer, sht As Worksheet i = 2 '保存第1个工作表名称的单元格在第2行 Set sht = Worksheets("数据") '将保存工作表名称的工作表赋给变量sht Do While sht.Cells(i, "A") <> "" '直到A列的单元格为空时退出循环 Worksheets.Add after:=Worksheets(Worksheets.Count) '在所有工作表后插入新工作表 ActiveSheet.Name = sht.Cells(i, "A").Value '更改工作表的标签名称 i = i + 1 '行号增加1 LoopEnd Sub例2 用前面的程序新建工作表，要求在“数据”工作表A列中保存的工作表名称不存在重复数据，否则会因为Excel不能在同一个工作簿中插入两张同名工作表而导致程序执行出错。Excel不允许在同一工作簿中插入多张同名的工作表，但是预先并不确定“数据”工作表A列中是否存在相同的数据，为了避免程序在执行过程中出错，我们希望在遇到相同的数据时，只插入一张该名称的工作表。Sub ShtAdd() Dim i As Integer, sht As Worksheet i = 2 Set sht = Worksheets("成绩表") '定义循环条件 Do While sht.Cells(i, "C").Value <> "" '当没有对应班级工作表时，忽略下一行代码引起的运行时错误 On Error Resume Next '判断工作表否存在 If Worksheets(sht.Cells(i, "C").Value) Is Nothing Then Worksheets.Add after:=Worksheets(Worksheets.Count) ActiveSheet.Name = sht.Cells(i, "C").Value End If i = i + 1 LoopEnd Sub4.6.7 批量对数据分类，并保存到不同的工作表中在一张成绩表中，保存着同一年级多个班级的成绩记录，现要根据所属班级对成绩记录进行分类，并保存到与成绩表结构相同(已有表头)，以班级名称命名的工作表中。Sub FenLei() '将成绩表按班级分类并保存到各工作表中 Dim i As Long, bj As String, rng As Range i = 2 '成绩表中要处理的第1条记录在第2行 bj = Worksheets("成绩表").Cells(i, "C").Value Do While bj <> "" '直到成绩表中的C列的单元格为空单元格时终止循环 '确定班级工作表中A列的第1个空单元格，作为粘贴成绩记录的目标区域 Set rng = Worksheets(bj).Range("A1048576").End(xlUp).Offset(1, 0) Worksheets("成绩表").Cells(i, "A").Resize(1, 7).Copy rng '将成绩表中的记录复制到相应的工作表中 i = i + 1 '行号加1,以便下次循环时能处理下一条成绩记录 bj = Worksheets("成绩表").Cells(i, "C").Value LoopEnd Sub例2 如果工作簿中的班级工作表中原来已经有数据记录，执行程序前，要将原有的记录清除。Sub 清除原表数据() Dim sht As Worksheet For Each sht In Worksheets If sht.Name <> "成绩表" Then sht.Range("A2:G1048576").ClearContents End If NextEnd Sub4.6.8 将多张工作表中的数据合并到一张工作表中Sub hebing() '把各班成绩表中的记录合并到"成绩表"工作表中 Dim sht As Worksheet Set sht = Worksheets("成绩表") sht.Rows("2:65536").Clear '删除成绩表中的原有记录 Dim wt As Worksheet, xrow As Integer, rng As Range For Each wt In Worksheets '循环处理工作簿中的每张工作表 If wt.Name <> "成绩表" Then Set rng = sht.Range("A1048576").End(xlUp).Offset(1, 0) xrow = wt.Range("A1").CurrentRegion.Rows.Count - 1 wt.Range("A2").Resize(xrow, 7).Copy rng End If NextEnd Sub4.6.9 将工作簿中的每张工作表都保存为单独的工作簿文件Sub SaveToFile() '把各个班级的成绩表保存在指定的文件夹中 Application.ScreenUpdating = False '关闭屏幕更新 Dim folder As String folder = ThisWorkbook.Path & "\班级成绩表" '保存工作簿文件的目录 If Len(Dir(folder, vbDirectory)) = 0 Then MkDir folder '选择是否新建该文件夹 Dim sht As Worksheet For Each sht In Worksheets sht.Copy '复制工作表到新工作簿 ActiveWorkbook.SaveAs folder & "\" & sht.Name & ".xlsx" '保存工作簿，并命名 ActiveWorkbook.Close Next Application.ScreenUpdating = True '开启屏幕更新End Sub注意：使用MkDir新建文件夹，变量folder是新建的文件夹的名称及所在目录。4.6.10 将工作簿中的数据合并到同一张工作表中Sub HzWb() Dim bt As Range, r As Long, c As Long r = 1 '1 是表头的行数 c = 7 '7 是表头的列数 Dim wt As Worksheet Set wt = ThisWorkbook.Worksheets(1) '将汇总表赋给变量wt wt.Rows(r + 1 & ":1048576").ClearContents ' 清除汇总表中原表数据,只保留表头 Application.ScreenUpdating = False Dim FileName As String, sht As Worksheet, wb As Workbook Dim Erow As Long, fn As String, arr As Variant FileName = Dir(ThisWorkbook.Path & "\*.xlsx") '这是要汇总的工作簿文件的扩展名，只有扩展名为“xlsx”的工作簿中的记录才会被汇总。 Do While FileName <> "" If FileName <> ThisWorkbook.Name Then ' 判断文件是否是汇总数据的工作簿 Erow = wt.Range("A1").CurrentRegion.Rows.Count + 1 ' 取得汇总表中第一条空行行号 fn = ThisWorkbook.Path & "\" & FileName '将第1个要汇总的工作簿名称赋给变量fn Set wb = GetObject(fn) ' 将变量fn 代表的工作簿对象赋给变量wb Set sht = wb.Worksheets(1) ' 将要汇总的工作表赋给变量sht ' 将工作表中要汇总的记录保存在数组arr里 arr = sht.Range(sht.Cells(r + 1, "A"), sht.Cells(1048576, "B").End(xlUp).Offset(0, 5)) ' 将数组arr 中的数据写入工作表 wt.Cells(Erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr wb.Close False End If FileName = Dir ' 用Dir 函数取得其他文件名，并赋给变量 Loop Application.ScreenUpdating = TrueEnd Sub4.6.11 为同一工作簿中的工作表建一个带链接的目录Sub mulu() '为工作簿中所有工作表建立目录! Dim wt As Worksheet Set wt = Worksheets("工作表目录") wt.Rows("2:1048576").ClearContents '清除工作表中原有数据 Dim sht As Worksheet, irow As Integer irow = 2 For Each sht In Worksheets wt.Cells(irow, "A").Value = irow - 1 '写入序号 '写入工作表名，并建立超链接 wt.Hyperlinks.Add Anchor:=wt.Cells(irow, "B"), Address:="", _ SubAddress:="'" & sht.Name & "'!A1", TextToDisplay:=sht.Name irow = irow + 1 '行号加1 NextEnd Sub问题：如果工作簿中已有设置好表头，且名称为“工作表目录”的工作表，执行前面的程序后就能完成制作目录的操作，反之，执行程序就会出错。如果想在工作簿中没有名称为“工作表目录”的工作表时，让程序自动新建这张工作表后，再在其中制作目录，以避免程序在执行过程中出现错误，你知道应该怎样修改本例的程序吗？Sub 为所有工作表制作目录() Dim sht As Worksheet Dim wt As Worksheet Dim irow As Integer On Error Resume Next Set wt = Worksheets("工作表目录") '如果目录工作表不存在，则新建工作表 If wt Is Nothing Then Worksheets.Add before:=Worksheets(1) ActiveSheet.Name = "工作表目录" Set wt = Worksheets("工作表目录") End If On Error GoTo 0 '设置目录工作表的表头 With wt .Cells.ClearContents .Range("A1:B1").Value = Array("序号", "工作表名称") End With '为工作簿中所有工作表建立目录 irow = 2 For Each sht In Worksheets '写入序号 wt.Cells(irow, "A").Value = irow - 1 '写入工作表名，并建立超链接 wt.Hyperlinks.Add Anchor:=wt.Cells(irow, "B"), Address:="", _ SubAddress:="'" & sht.Name & "'!A1", TextToDisplay:=sht.Name irow = irow + 1 NextEnd Sub
0 0
