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").Name
4.3.2 访问对象的属性,获得工作簿文件的信息
Sub WbMsg()
Range("B2") = ThisWorkbook.Name
Range("B3") = ThisWorkbook.Path
Range("B4") = ThisWorkbook.FullName
End Sub
4.3.3 用Add方法创建工作簿
Workbooks.Add
Workbooks.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").Activate
4.3.8 ThisWorkbook与ActiveWorkbook
ThisWorkbook 和 ActivateWorkbook 都是Application对象的属性,都返回Workbook对象。但是,它们之间并不是等同的。ThisWorkbook是对代码所在的工作簿的引用,ActiveWorkbook是对活动工作簿的引用。
Sub wb()
Workbooks.Add
MsgBox "代码所在的工作簿为:" & ThisWorkbook.Name
MsgBox "当前活动工作簿为:" & ActiveWorkbook.Name
ActiveWorkbook.Close savechanges:=False
End Sub
4.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 = 700
Range("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输入数值100
End Sub
要引用定义为名称的单元格,可以将Range属性的参数设置为表示名称名的字符串或变量,例如:
Range("C_Date").Value = 100
2. 引用多个不连续的单元格区域
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:=xlToRight
Columns("A:A").Insert Shift:=xlToRight
Range("C1").Select
ActiveSheet.Rows(Selection.Row).Insert
ActiveSheet.Columns(Selection.Column).Insert
Range("C1").Select
Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove '插入一整行 ,单元格的移动方向向下,插入的行格式随上面行的格式
4.5.2 用Cells属性引用单元格
1. 引用工作表中指定行列交叉的单元格
ActiveSheet.Cells(3, 4).Value = 20
ActiveSheet.Cells(3, "D").Value = 20
在使用Cells引用工作表中的某个单元格时,总是可以将代码写为:
工作表对象.Cells(行号, 列标)
2. 引用单元格区域中的某个单元格
Range("B3:F9").Cells(2,3) = 100 '在B3:F9区域的第2行与第3列交叉的单元格中输入100
3. 将Cells属性的返回结果设置为Range属性的参数
还可以将Cells属性设置为Range属性的参数,例如:
Range(Cells(1, 1), Cells(10, 5)).Select '选中当前工作表的A1:E10单元格
这行代码和下面的两行代码是等效的
Range("A1", "E10").Select
Range(Range("A1"), Range("E10")).Select
4. 使用索引号引用单元格
Cells是工作表中所有单元格组成的集合,可以使用索引号引用该集合中的某个单元格,例如:
ActiveSheet.Cells(2).Value = 200 '在活动工作表的第二个单元格输入200
4.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").Select
4.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.Select
End Sub
4.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 = 500
Range("D7:F8").Offset(-5, -2).Value = 500
4.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+上方向键】组合键得到的单元格
其他可设置的参数
xlToLeft
xlToRight
xlUp
xlDown
当使用程序向一张工作表中添加数据时,我们希望将数据添加到工作表的第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 Explicit
Sub 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 If
End Sub
4.5.12 单元格中的内容:Value属性
Range("A1:B2").Value = "abc" '在A1:B2中输入abc
Range("B1").Value = Range("A1").Value '把A1单元格中的数据写入B1单元格中
Value是Range对象的默认属性,在给区域赋值时,可以省略属性名称,将代码写为:
Range("A1:B2") = "abc" '在A1:B2单元格中输入abc
4.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.Address
4.5.15 用Activate与Select方法选中单元格
要选中一个单元格区域,可以使用Range对象的Activate方法和Select方法,例如:
ActiveSheet.Range("A1:F5").Activate '选中活动工作表中的A1:F5
ActiveSheet.Range("A1:F5").Select '选中活动工作表中的A1:F5
4.5.16 选择清除单元格中的信息
'清除B2单元格中所有的信息(包括批注、内容、格式、超链接等)
Range("B2").Clear
'清除B2单元格中的批注
Range("B2").ClearComments
'清除B2单元格中的内容
Range("B2").ClearContents
'清除B2单元格中的格式
Range("B2").ClearFormats
'清除B2单元格中的超链接
Range("B2").ClearHyperlinks
4.5.17 用Copy方法复制单元格区域
录制宏示例:
Sub CopyTest()
Range("A1").Select
Selection.Copy
Range("C1").Select
ActiveSheet.Paste
End 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:=xlPasteValues
End Sub
或
Sub CopyValues()
Range("F1:I10").Value = Range("A1:D10").Value
End Sub
4.5.18 用Cut方法剪切单元格
使用Cut方法可以将一个单元格区域剪切到另一个单元格区域。
剪切单元格和复制单元格,除方法名称不同外,其他基本相似。
Range("A1:E5").Cut Destination:=Range("G1") '把A1:E5剪切到G1:K5
Range("A1").Cut Range("G1") '把A1剪切到G1
4.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:=xlUp
4.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 Sub
4.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 If
End Sub
4.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 If
End Sub
4.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
Next
End Sub
例2 将工作簿中所有的工作表都取消隐藏
Sub ShowAllSheets()
Dim sht As Worksheet
For Each sht In Worksheets
sht.Visible = True
Next
End Sub
4.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
Loop
End 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
Loop
End Sub
4.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
Loop
End Sub
例2 如果工作簿中的班级工作表中原来已经有数据记录,执行程序前,要将原有的记录清除。
Sub 清除原表数据()
Dim sht As Worksheet
For Each sht In Worksheets
If sht.Name <> "成绩表" Then
sht.Range("A2:G1048576").ClearContents
End If
Next
End Sub
4.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
Next
End Sub
4.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 = True
End Sub
4.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
Next
End 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
Next
End Sub