一、对象模型

VBE 帮助( H ”——“Microsoft Visual Basic 帮助( H F1”——“Visual Basic 语言参考 ”——“ 函数 或者在 VBE 下快捷键 “F1”

地址: https://docs.microsoft.com/zh-cn/office/vba/api/overview/excel/object-model

二、 Application 对象( Excel 顶层对象)

1 ScreenUpdating 属性

是否控制屏幕更新, False 表示关闭屏幕更新, True 表示打开屏幕更新

设置 ScreenUpdating=False 关闭屏幕更新,将看不到程序的执行过程,可以加快程序的执行速度,让程序显得更直观,专业。

示例(为关闭屏幕更新下,会弹出对话框):

Sub InputTest()

Cells.ClearContents ' 清除表中所有数据

Range( "A1:A10" ) = 100

MsgBox " 刚才在A1:A10输入数值100,你能看到结果吗?"

Range( "B1:B10" ) = 200

MsgBox " 刚才在B1:B10输入数值200,你能看到结果吗?"

End Sub

示例(关闭屏幕更新,看不到执行过程,程序最终执行完成才能看到最终结果)

Sub InputTest()

Cells.ClearContents ' 清除表中所有数据

Application.ScreenUpdating = False ' 关闭屏幕更新

Range( "A1:A10" ) = 100

MsgBox " 刚才在A1:A10输入数值100,你能看到结果吗?"

Range( "B1:B10" ) = 200

MsgBox " 刚才在B1:B10输入数值200,你能看到结果吗?"

Application.ScreenUpdating = True ' 恢复屏幕更新

End Sub

2 DisplayAlterts 属性

是否显示警告对话框, False 为不显示, True 为显示

Sub delSht()

Dim sht As Worksheet

Application.DisplayAlerts = False ' 不显示警告信息

For Each sht In Worksheets

If sht.Name = ActiveSheet.Name Then ' 判断sht是不是活动工作表

sht.Delete ' 删除sht代表的工作表

End If

Application.DisplayAlerts = True ' 恢复显示警告信息

End Sub

3 EnableEvents 属性

启用或禁用事件, False 为禁用(不让事件发生), True 为启用

什么是事件?能被 Excel 认识的一个操作动作,例如 打开工作簿 关闭工作簿

  • 示例 1 :编写一个程序,当选中工作表的单元格时,自动在单元格中写入该单元格的地址

Private Sub Worksheet_SelectionChange( ByVal Target As Range)

Target.Value = Target.Address

End Sub

  • 示例 2 :选中活动单元格,记录对应单元格地址,并将活动单元格向下移动一个单元格

Private Sub Worksheet_SelectionChange( ByVal Target As Range)

Target.Value = Target.Address

Application.EnableEvents = False ' 禁用事件

Target.Offset( 1 , 0 ).Select ' 选中活动单元格下面的一个单元格

Application.EnableEvents = True ' 启用事件

End Sub

4 WorksheetFunction 属性

使用 WorksheetFunction 调用 Excel 内置函数

  • 示例 1 :统计 A1:A50 单元格中数值大于 1000 的单元格有多少个?

Sub CountTest()

Dim mycount As Integer , rng As Range

For Each rng In Range( "A1:B50" )

If rng.Value > 1000 Then mycount = mycount + 1

MsgBox "A1:B50 中大于1000的单元格个数为:" & mycount

End Sub

  • 示例 2 统计 A1:A50 单元格中数值大于 1000 的单元格有多少个?使用 COUNTIF 函数

Sub CountTest()

Dim mycount As Integer

mycount = Application.WorksheetFunction.CountIf(Range( "A1:B50" ), ">1000" )

MsgBox "A1:B50 中大于1000的单元格个数为:" & mycount

End Sub

5 、给 Excel 梳妆打扮

  • Excel 工作表界面相关命令
  • Excel 界面

6 Application 的常用属性

三、 Workbook 对象

Workbook 工作簿

Workbooks 工作簿集合

1 、怎么引用工作簿

引用工作簿,就是指明工作簿的位置及名称,共有两种方式

方式一:利用索引号引用工作簿, Workbook.Item(3) ,这里的 Item 可以省略,即 Workbook(3)

方式二:利用工作簿名称引用 Workbook("Book1") Workbook("Book1.xls") ,如果本地文件显示拓展名(且文件已经保存),则文件名必须带拓展名,否则会报错。

2 Workbook 名片信息

Sub wbMsg()

Range( "B2" ) = ThisWorkbook.Name ' 返回当前工作簿名称 练习 -副本.xlsm

Range( "B3" ) = ThisWorkbook.Path ' 返回当前工作簿路径 C:\Users\ThinkPad\Desktop

Range( "B4" ) = ThisWorkbook.FullName ' 返回当期工作簿带名称的路径 C:\Users\ThinkPad\Desktop\练习 - 副本.xlsm

End Sub

3 、创建工作簿

  • 使用方法: Workbooks.Add

如果不带任何参数,将创建包含一定数目空白工作表的新工作簿(数目由 SheetsInNewWorkbook 属性决定)

  • 也可以给 Add 方法设置参数 ( 参数表示现有 Excel 名称的字符串,选用该参数,新建的工作簿将以该文件作为模板 )

Workbooks.Add "C:\Program Files\Microsoft Office\Templates\2052\ADDRESS\ADDRESS.XLS"

  • 也可以通过参数指定新建工作簿中包含的工作类型

Workbooks.Add xlWBATChart ' 新建图表工作表

  • Excel 一共有 4 种类型的工作表

可以在插入对话框里看到 ( 选中工作表名称 —— 鼠标右键单击 —— 插入 —— 即可显示 ) ,如图(包含参数说明):

4 、打开工作簿

使用 Workbooks Open 方法(参数名要写含路径的名称)

Sub OpenFile()

Workbooks.Open Filename:= "F:\Book1.xls"

End Sub

参数名成可以省略不写 (Open 除了 Filename 参数外,还有 14 个参数,让用户决定以何种方式打开指定的文件,可以通过系统的帮助来查看更多的信息 )

Sub OpenFile()

Workbooks.Open "F:\Book1.xls"

End Sub

5 、激活工作簿

同事打开多个工作簿,但是同一时间只能有一个窗口是活动的,调用 Workbooks 对象的 Active 方法可以激活一个工作簿。

Sub JhWb()

Workbooks( "Book1.xls" ).Activate ' 激活工作簿

End Sub

6 、保存工作簿

保存工作簿调用 Workbooks Save 方法

Sub SaveWb()

ThisWorkbook.Save ' 保存代码所在的工作簿

End Sub

如果想将文件另存为一个新的文件,或者第一次保存一个新建的工作簿,就用 SaveAs 方法。

参数指定文件保存的路径及文件名如果省略路径,则默认将文件保存在当前文件夹中

Sub SaveWb()

ThisWorkbook.SaveAs Filename:= "D:\test.xls"

End Sub

使用 SaveAs 方法将工作簿另存为新文件后,将自动关闭原文件,打开新文件,如果希望继续保留原文件不打开新文件,可以用 SaveCopyAs 方法

Sub SaveWb()

ThisWorkbook.SaveCopyAs Filename:= "D:\test.xls"

End Sub

7 、关闭工作簿

关闭工作簿使用 Workbooks Close 方法,如果不带参数,则关闭所有打开的工作簿

Sub CloseWb()

Workbooks.Close ' 关闭所有打开的工作簿

End Sub

如果想关闭指定的工作簿,需要指定参数

Sub CloseWb()

Workbooks( "Book1.xls" ).Close ' 关闭Book1.xls

End Sub

如果关闭之前被更改过的内容没有保存,关闭工作簿前 Excel 会询问用户是否保存更改,如果不想显示该对话框,可以给 Close 方法设置参数:

Sub CloseWb()

Workbooks( "Book1.xls" ).Close savechanges:= True ' 关闭并保存Book1.xls

End Sub

关闭并保存的参数 savechanges 也可以省略不写:

Sub CloseWb()

Workbooks( "Book1.xls" ).Close True ' 关闭Book1.xls

End Sub

8 ThisWorkbook ActiveWorkbook

同是 Application 对象的属性,同是返回 Workbook 对象,但二者并不是等同的。

ThisWorkbook 是对程序所在的工作簿的引用

ActiveWorkbook 是对活动工作簿的引用

新建的工作簿总会成为活动工作簿

Sub wb()

Workbooks.Add

MsgBox " 代码所在的工作簿为:" & ThisWorkbook.Name & Chr ( 13 ) _

& " 当前活动工作簿为:" & ActiveWorkbook.Name

ActiveWorkbook.Close savechanges:= False

End Sub

四、 Worksheet 对象

Worksheet 表示一张普通的工作表, Worksheets 表示多个 Worksheet 对象的集合。

1 、引用工作表

可以使用工作表的索引号或者标签名称引用它

Worksheets.Item ( 1 ) ' 引用工作表里的第一张工作表

Worksheets ( 1 ) ' 引用工作表里的第一张工作表

Worksheets ( "Sheet1" ) ' 引用工作簿里标签名称为"Sheet1"的工作表

因为代码名称只能在【属性窗口】里修改,不会随着工作表标签名称或索引号的变化而变化。因此,当工作表的索引号或标签名称经常变化时,使用代码名称引用工作表会更方便。

使用代码名称引用工作表,只需直接写代码名称

例如:第一张工作表的 A1 单元格输入 100 ,代码为: Sheet1.Range("A1")=100

查看工作表的代码名称,可以读取它的 CodeName 属性,如果想知道活动工作表的代码名称,代码为:

Sub ShowShtCode()

MsgBox ActiveSheet.CodeName

End Sub

2 、新建工作表

新建工作表使用 Worksheets Add 方法

  • 不带任何参数,将在活动工作表新建一张工作表

Worksheets.Add

  • 可以用参数给新建的工作表指定位置

Worksheets.Add before:=Worksheets(1)  ' 在第一张工作表前插入一张新的工作表

Worksheets.Add after:=Worksheets(1) ‘ 在第一张工作表后插入一张新的工作表

  • 还可以同时插入多张工作表

Worksheets.Add Count:=3  ' 在活动工作表前插入 3 张工作表, Count 参数的缺省值为 1

  • 可以同时使用多个参数,不同参数之间用英文逗号隔开

Sub shtAdd()

Worksheets.Add after:=Worksheets( 1 ), Count:= 3

End Sub

在最后一张工作表后插入两张工作表

Sub shtAdd()

' 在最后一个工作表后插入两张工作表

Worksheets.Add before:=Worksheets(Worksheets.Count), Count:= 2

End Sub

  • Add 方法有哪些参数?请看 VBE 的提示

3 、更改工作表标签名称

  • 更改工作表标签名称,设置工作表 Name 属性

Worksheets(2).Name=" 工资表 "   ' 更改第二张工作表的标签名称为 工资表

  • 新建工作表时在程序中更改标签名称

Sub shtAdd()

Worksheets.Add Before:=Worksheets( 1 )

ActiveSheet.Name = " 工资表"

End Sub

  • 新建工作表同时指定它的标签名称

Sub shtAdd()

' 在第一张工作表前插入一个名称为“工资表”的工作表

Worksheets.Add(before:=Worksheets( 1 )).Name = " 工资表"

End Sub

  • 如果同时添加多张工作表(即 Count 参数值大于 1 ),并不能使用一句代码同时命名

4 、删除工作表

删除工作表使用 Worksheets 对象的 Delete 方法

Worksheets("Sheet1").Delete   ' 删除 Sheet1 工作表

5 、激活工作表

激活工作表可以使用 Activate 方法和 Select 方法

Worksheets(1).Activate ' 激活第一张工作表
Worksheets(1).Select ' 激活第一张工作表

6 、复制工作表

复制工作表使用 Copy 方法

Sub shtCopy()

' 这里的工作表名称一定要存在,否则执行会报错

Worksheets( " 工资条" ).Copy ' 不带参数   复制工作表,同时新建工作簿用于存放copy来的工作表(未保存状态)

Worksheets( " 工资条" ).Copy before:=Worksheets( "Sheet1" ) ' 带参数  复制工作表,存放在当前工作簿的工作表Sheet1之前

Worksheets( " 工资条" ).Copy after:=Worksheets( "Sheet1" ) ' 带参数   复制工作表,存放在当前工作簿的工作表Sheet1之后

End Sub

7 、移动工作表

移动工作表与复制工作表类似,使用方法 Move

Sub shtMove()

Worksheets( " 工资条" ).Move ' 不指定参数,将把工作表移动到新的工作簿中(新建工作簿)

Worksheets( " 工资条" ).Move before:=Worksheets( "Sheet1" ) ' 复制工作表,存放在当前工作簿的工作表Sheet1之前

Worksheets( " 工资条" ).Move after:=Worksheets( "Sheet1" ) ' 复制工作表,存放在当前工作簿的工作表Sheet1之后

End Sub

8 、隐藏和显示工作表

使用工作表的 Visible 属性显示或隐藏工作表

' 以下这三行代码作用一样,等同于从【格式】菜单中隐藏工作表

Worksheets( " 工资条" ).Visible = False

Worksheets( " 工资条" ).Visible = xlSheetHidden

Worksheets( " 工资条" ).Visible = 0

用下面方法隐藏的工作表,跟上面 3 种方法不一样,且通过这种方法隐藏的工作表,无法通过菜单取消隐藏,只能通过 VBA 在属性窗口设置或者用代码取消隐藏

Worksheets( " 工资条" ).Visible = xlSheetVeryHidden

Worksheets( " 工资条" ).Visible = 2

无论以何种方式隐藏了工作表,都可以用如下代码中的任意一句显示它

Worksheets( " 工资条" ).Visible = True

Worksheets( " 工资条" ).Visible = xlSheetVisible

Worksheets( " 工资条" ).Visible = 1

Worksheets( " 工资条" ).Visible = - 1

9 、获取工作表的数目

使用 Worksheets.Count

Dim mycount%

mycount=Worksheets.Count

10 Sheets Worksheets

  • 不同的命令,返回相同的结果

Sheets( 2 ).Name

Worksheets( 2 ).Name

Sheets.Count

Worksheets.Count

  • 分别代表两种不同的集合

Excel 里共有 4 中不同类型的工作表, Sheets 表示公祖不里所有类型的工作表的集合,而 Worksheets 只表示普通工作表的集合。
Sheets Worksheets 集合里的对象都有标签名称 Name 、代码名称 CodeName 、索引号 Index 等属性,也有 Add Delete Copy Move 等方法,设置属性和调用方法类似。但是因为 Sheets 集合包含更多类型的工作表,所有其包含的方法和属性比 Worksheets 集合多。

五、 Range 对象

1 Worksheet( Range) 对象的 Range 属性

  • 引用单元格并赋值

Worksheets("sheet1").Range("A1").Value=50

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

Sub rng()

Range( "date" ).Value = 200

End Sub

  • 引用多个不连续的区域,用逗号隔开

Sub rng()

Range( "A1:A10,A4:E6,C3:D9" ).Value = 200

End Sub

  • 用空格而不是逗号,则表示选中区域交集部分

Sub rng()

Range( "A1:B10 A4:D9" ).Value = 200

End Sub

2 Worksheet( Range) 对象的 Cells 属性

  • 指定单元格

Sub shtCells()

ActiveSheet.Cells( 3 , 4 ).Value = 20 ' 在第3行,第4列香蕉的单元格输入20

ActiveSheet.Cells( 3 , "D" ).Value = 30 ' 在第3行,第D列相交的单元格输入30

Range( "B3:F9" ).Cells( 2 , 3 ) = 40 ' 在区域“B3:F9”区域中的第2行,第3列相交的单元格,即D4

ActiveSheet.Cells( 2 ).Value = 50 ' 在活动工作表的第二个单元格输入50,这里使用的数字2是单元格序号, 序号是按照单元格区域内由左向右递增

' 选中活动工作表的A1:E10

Range(Cells( 1 , 1 ), Cells( 10 , 5 )).Select

' 以下两个语句等价

Range( "A1" , "E10" ).Select

Range(Range( "A1" ), Range( "E10" )).Select

End Sub

  • 全部单元格

Sub shtCells()

ActiveSheet.Cells.Select ' 选中活动工作表的所有单元格

Range( "B3:E9" ).Select ' 选中活动工作表中B3:E9单元格区域

End Sub

  • 更简短的快捷方式

Sub shtCells()

[A1] = 10

[A1:B10] = 20

[B3:D10 A4:G8] = 100 ' 公共交叉区域,如果两个区域参数没有逗号,表示一个参数,而参数表示的区域没有交集的话会报错

[A1:A10,C1:C10,E1:E10] = 200 ' 合并区域

[area] = 300 ' 名称are代表单元格,即单元格名称为area

End Sub

[] Application 对象的 Evaluate 方法的简写形式,这种简写形式非常适合饮用一个固定的 Range 对象,但是因为不能再方括号中使用变量,所以这种引用方式缺少灵活性。

4 、其他获取单元格的方式(除了 Range Cells 外) —Rows

ActiveSheet.Rows ' 选中活动工作表的所有行

ActiveSheet.Rows( 3 ).Select ' 选中活动工作表的第3行

ActiveSheet.Rows( "3:3" ).Select ' 选中活动工作表的第3行

ActiveSheet.Rows( "3:5" ).Select ' 选中活动工作表的第3行到第5行

Rows( "3:10" ).Rows( "1:1" ).Select ' 选中第3行到第10行区域内的第一行

5 、其他获取单元格的方式(除了 Range Cells 外) —Columns

ActiveSheet.Columns ' 选中活动工作表的所有列

ActiveSheet.Columns ( 6 ) ' 选中活动工作表中的第6列

ActiveSheet.Columns ( "F:G" ) ' 选中活动工作表中的F至G列

Columns( "B:G" ).Columns( "B:B" ).Select ' 选中B:G区域中的第2列

6 Application Union 方法

Union 方法像一支强烈的粘合剂,将不连续的多个单元格区域粘在一起,可以同时对其进行操作。

Sub rngUnion()

Application.Union(Range( "A1:A10" ), Range( "D1:D5" )).Select ' 入参至少为2个区域,至多30个区域,区域之间用逗号分隔

Union(Range( "A1:A10" ), Range( "D1:D5" )).Select 'application 可以省略不写

End Sub

7 Range 对象的 Offset 属性

Offset 属性用来基于基于单元格的位置移动

Offset(x,y) 两个参数, x 表示行移动,即 x>0 表示向下移动, x<0 表示向上移动; y 表示列移动,即 y>0 表示向右移动, y<0 表示向左移动。

参数移动方向示意图:

Sub rngOffset()

Range( "A1" ).Offset( 2 , 3 ).Value = 500 ' 基于“A1”单元格,向下移动2行,向右移动3列

Range( "C5:D6" ).Offset(- 3 , 0 ).Select ' 在“C5:D6”区域的基础上,向上移动3行,列方向参数为0,不移动。

End Sub

8 Range 对象的 Resize 属性

使用 Range 对象的 Resize 属性扩大或缩小指定的单元格区域,得到一个新的单元格区域。

Resize 共有两个参数,第一个参数确定新区域的行数,第二个参数确定新区域的列数,两个参数的值都是正整数,最小为 1.

新区域把该对象最左上角的单元格当成自己左上角第一个单元格

Sub rngResize()

' 将B2单元格扩大为B2:E6

Range( "B2" ).Resize( 5 , 4 ).Select

' 将B2:E6单元格缩小为B2:B3,新区域以B2单元格为最左上角单元格

Range( "B2:E6" ).Resize( 2 , 1 ).Select

' 上句等同于

Range( "B2:E6" ).Cells( 1 ).Resize( 2 , 1 ).Select

End Sub

9 Worksheet 对象的 UsedRange 属性

UsedRange 属性返回工作表中已经使用的单元格围成的矩形区域(不管这些区域间是否有空行,空列或空单元格)。

Sub rngUsed()

ActiveSheet.UsedRange.Select

End Sub

10 Range 对象的 CurrentRegion 属性

CurrentRegion 返回当前区域,即以空行和空行的组合为边界的区域

Sub rngUsed()

Range( "D3" ).CurrentRegion.Select

End Sub

11 Range 对象的 End 属性

End 属性返回当前区域结尾处的单元格,等同于在源单元格按 <End+ 方向键(上下左右) > 得到的单元格。

Sub rngEnd()

Range( "E5" ).End(xlUp).Select

End Sub

共有 4 个参数,说明如下:

什么情况会用到 End 属性?工作表中记录的行数随时都在变化,应该把新记录写入工作表的第 5 行还是第 10 行?

可以用 End 属性解决这个问题

Sub rngEnd()

' 取第一个单元格,如果非空则向下移动一个单元格,否则不移动。对新单元格进行赋值

Dim c As Range

Set c = ActiveSheet.Range( "A65536" ).End(xlUp)

If c.Value <> "" Then

Set c = c.Offset( 1 , 0 )

End If

c.Value = " 张青"

End Sub

Sub rngUsed()

' 取使用区域内行数增加1,对该行的A列进行赋值

Dim xrow As Long

xrow = ActiveSheet.UsedRange.Rows.Count + 1

Cells(xrow, "A" ).Value = " 张青"

End Sub

Sub rngCurr()

' 取当前区域内行数增加1,对该行的A列进行赋值

Dim xrow As Long

xrow = Range( "A1" ).CurrentRegion.Rows.Count + 1

Cells(xrow, "A" ).Value = " 张青"

End Sub

六、操作单元格,还需要了解

1 、单元格内容 -Value

Range( "A1:B2" ).Value = "abc"

Range( "A1:B2" ) = "abc" 'Value 是Range的默认属性,在给区域赋值时可以省略。

2 、单元格个数 -Count

Range( "B4:F10" ).Count ' 统计单元格数量

ActiveSheet.UsedRange.Rows.Count ' 统计活动单元格的行数

ActiveSheet.UsedRange.Columns.Count ' 统计活动单元格的列数

3 、单元格地址 -Address

MsgBox " 当前选中的单元格地址为 "&Selection.Address

4 、选中单元格 -Active Select

以下两组代码是等效的。

ActiveSheet.Range( "A1:B10" ).Select

ActiveSheet.Range( "A1:B10" ).Activate

5 、选择性清除单元格 -Clear

Range( "B2:B15" ).Clear ' 清除B2:B15单元格所有内容(包括批注、内容、注释、格式等)

Range( "B2:B15" ).ClearComments ' 清除B2:B15单元格批注

Range( "B2:B15" ).ClearContents ' 清除B2:B15单元格内容

Range( "B2:B15" ).ClearFormats ' 清除B2:B15单元格格式

6 、复制 & 粘贴单元格区域 -Copy&Paste

  • 录制复制和粘贴的宏内容如下:

Sub Macro1()

Range( "A1" ).Select

Selection.Copy

Range( "C1" ).Select

ActiveSheet.Paste

End Sub

  • 但在执行复制或者粘贴操作之前并不需要选中单元格,所以代码可以简化为:

Sub Macro1()

Range( "A1" ).Copy Range( "C1" ) 'A1 是源单元格,C1是目标单元格

End Sub

  • 带参数的复制 -Destination

Sub Macro1()

Range( "A1" ).Copy Destination:=Range( "C1" ) 'A1 是源单元格,C1是目标单元格,Destination是目标

End Sub

  • 带参数的复制 -CurrentRegion

要复制的单元格区域不能确定大小,可以只指定一个单元格作为目标区域的最左上角单元格

Sub Macro1()

Range( "A1" ).CurrentRegion.Copy Range( "C1" ) 'A1 是源单元格,C1是目标单元格,Destination是目标

End Sub

  • 想粘贴源区域的数值(以下两个式子等价)

Sub rngCopyValue_1()

Range( "A1:A10" ).Copy

Range( "F1:F10" ).PasteSpecial Paste:=xlPasteValues ' 仅粘贴数值

End Sub

Sub rngCopyValue_2()

Range( "A1:A10" ).Value = Range( "F1:F10" ).Value

End Sub

7 、剪切单元格 -Cut

Sub rngCut()

Range( "A1:A5" ).Cut Destination:=Range( "G1" ) ' 把A1:A5剪切到G1:G5,这里G1表示以G1为左上角第一个单元格的区域

Range( "F6:F10" ).Cut Range( "G6" ) ' 把F1:F10剪切到G6:K10,参数Destination可以省略

End Sub

8 、删除单元格 -Delete

Delete 4 个选项,分别对应如下参数:

Range( "B5" ).Delete Shift:=xlToLeft ' 删除B5单元格,删除后右侧单元格左移

Range( "B5" ).Delete Shift:=xlUp ' 删除B5单元格,删除后下方单元格上移

Range( "B5" ).EntireRow.Delete ' 删除B5单元格所在的行

Range( "B5" ).EntireColumn.Delete ' 删除B5单元格所在的列

9 、单元格名称, Names 集合

Excel 中定义的名称就是给单元格区域(或数值、常量、公式)取的名字,一个自定义的名称及时一个 Name 对象, Names 是工作簿中定义的所有名称的集合。

录制的宏告诉我们,怎样新建一个名称

'Add 新建名称的方法,RefersToR1C1表示使用R1C1引用样式

ActiveWorkbook.Names.Add Name = "date" , RefersToR1C1:= "Sheet1!R5C[-2]"

R5C[-2] 说明: R 后面的数值表示行号, C 后面的数值表示列号, [] 中括号表示相对引用,默认是绝对引用,相对应用时 R>0 表示向下移动, C>0 表示向右移动

R[2]C[3] :对活动单元格下方的第二行与右边的第 3 列相交的单元格的引用

R2C3 :对工作表中第二行与第 3 列相交的单元格的引用

  • 另一种单元格引用方式: A1 样式引用

'Add 新建名称的方法,RefersToR1C1表示使用A1引用样式,$表示相对绝对引用,将把活动单元格当做A1单元格

ActiveWorkbook.Names.Add Name = "date" , RefersTo:= "Sheet1$B$4"

  • 定义名称更简单的方式

Range( "A1:C10" ) = "date"

  • 怎样引用名称

ActiveWorkbook.Names( "date" ).Name = " 姓名"

ActiveWorkbook.Names( " 姓名" ).Name = " 张三"

  • 也可以使用名称索引引用名称

Sub UseName()

Dim i, mx As Integer

mx = ActiveWorkbook.Names.Count ' 统计一共有多少个单元格

For i = 1 To mx

activateworkbook.Names(i).Visible = False ' 隐藏名称

End Sub

10 、单元格批注, Comment 对象

一个批注就是一个 Comment 对象, Comments 是工作簿中所有 Comment 对象的集合

  • 给单元格增加批注

Range( "B5" ).AddComment Text:= " 我用VBA新建的批注"

  • 怎么知道单元格是否有批注

Sub wbComment()

Range( "B5" ).AddComment Text:= " 我用VBA新建的批注"

If Range( "B5" ).Comment Is Nothing Then ' 判断是否存在Comment对象

MsgBox "B5 单元格中没有批注"

MsgBox "B5 单元格中已有批注"

End If

End Sub

Sub operComment()

Range( "B5" ).AddComment Text:= " 我用VBA新建的批注" ' 新建批注

Range( "B5" ).Comment.Visible = False ' 隐藏B5单元格批注

Range( "B5" ).Comment.Delete ' 删除B5单元格批注

End Sub

11 、给单元格化妆

  • 设置字体 -Font

Sub FontSet()

With Range( "A1:L1" ).Font

.Name = " 宋体" ' 设置字体为宋体

.Size = 12 ' 设置字号为12号

.Color = RGB ( 255 , 0 , 0 ) ' 设置字体颜色为红色

.Bold = True ' 设置字体加粗

.Italic = True ' 设置字体倾斜显示

.Underline = xlUnderlineStyleDouble 'feud 文字添加双下划线

End With

End Sub

  • 给单元格增加底纹 -Interior

Sub InteriorSet()

Range( "A1:L1" ).Interior.Color = RGB ( 255 , 255 , 0 ) ' 增加黄色底纹

End Sub

  • 给表格设置表框

Sub InteriorSet()

With Range( "A1" ).CurrentRegion.Borders

.LineStyle = xlContinuous ' 设置单线边框

.Color = RGB ( 0 , 0 , 255 ) ' 设置边框颜色

.Weight = xlHairline ' 设置边框线条样式

End With

End Sub

可以在 单元格格式 对话框中进行其他设置,如果想用代码实现而不知道代码怎么写,可以手动操作,用宏录制器录下它。

七、典型的技巧与示例

1 、编写一个程序,按要求创求的一个新的工作簿,并把它保存到指定的文件夹。

Sub wbAdd()

' 程序创建“员工花名册”工作簿,保存在本工作簿所在的文件夹中

Dim wb As Workbook, sht As Worksheet ' 定义一个Workbook对象和一个Worksheet对象

Set wb = Workbooks.Add ' 新建一个工作簿

Set sht = wb.Worksheets( 1 )

With sht

.Name = " 花名册" ' 修改第一张工作表的标签名称

.Range( "A1:F1" ) = Array( " 序号" , " 姓名" , " 性别" , " 出生年月" , " 参加工作时间" , " 备注" ) ' 设置表头

End With

wb.SaveAs ThisWorkbook.Path & "\ 员工花名册.xls" ' 保存新建的工作表到本工作簿所在的文件夹中

ActiveWorkbook.Close ' 关闭新建的工作簿

End Sub

2 、判断工作簿是否打开

  • 工作簿是否打开判断

' 判断"成绩表.xls"工作簿是否打开

Sub isWbOpen()

Dim i As Integer

For i = 1 To Workbooks.Count

If Workbooks(i).Name = " 成绩表.xls" Then

MsgBox " 文件已打开"

Exit Sub ' 如果找到该文件,退出过程

End If

MsgBox " 文件没有打开"

End Sub

  • 工作表是否打开判断

' 判断打开的工作表中是否含“一年级”,有则移动到第一个位置,否则在第一个位置创建

Sub isShtOpen()

Dim sht As Worksheet

For Each sht In Worksheets

If sht.Name = " 一年级" Then

sht.Move before:=Worksheets( 1 )

'MsgBox " 已经打开"

Exit Sub

End If

Worksheets.Add(before:=Worksheets( 1 )).Name = " 一年级"

End Sub

另一种写法:

' 判断打开的工作表中是否含“一年级”,有则移动到第一个位置,否则在第一个位置创建

Sub isShtOpen()

On Error Resume Next

If Worksheets( " 一年级" ) Is Nothing Then

Worksheets.Add(before:=Worksheets( 1 )).Name = " 一年级"

Worksheet( " 一年级" ).Move before:=Worksheets( 1 )

'MsgBox " 已经打开"

End If

End Sub

3 、判断工作簿是否存在

Sub isExistWb()

' 判断本工作簿所在的文件夹中是否存在“员工花名册.xls”

Dim fil As String

fil = ThisWorkbook.Path & "\ 员工花名册.xls"

If Len ( Dir (fil)) > 0 Then

MsgBox " 工作簿已经存在"

MsgBox " 工作簿不存在"

End If

End Sub

4 、向未打开的工作簿中录入数据

Sub WbInput()

' 在本工作簿所在的文件夹下“员工花名册”里添加一条记录

Dim wb As String , xrow As Integer , arr

wb = ThisWorkbook.Path & "\ 员工花名册.xls"

Workbooks.Open (wb)

With ActiveWorkbook.Worksheets( 1 )

xrow = .Range( "A1" ).CurrentRegion.Rows.Count + 1

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

5 、隐藏活动工作表外的所有工作表

Sub ShtVisible()

' 隐藏活动工作表外的所有工作表

Dim sht As Worksheet

For Each sht In Worksheet

If sht.Name <> ActiveSheet.Name Then

sht.Visible = xlSheetVeryHidden ' 深度隐藏,不能通过“格式”菜单显示它

End If

End Sub

6 、批量新建工作表

Sub shtAdd()

' 一张成绩表中保存不同班级的数据,需要以班级名命名

' 根据C列的班级名新建不同的工作表

Dim i As Integer , sht As Worksheet

i = 2

Set sht = Worksheets( " 成绩表" )

Do While sht.Cells(i, "C" ) <> ""

Worksheets.Add after:=Worksheets(Worksheets.Count)

ActiveSheet.Name = sht.Cells(i, "C" ).Value

i = i + 1

End Sub

7 、批量对数据分类

Sub fenLei()

' 把成绩按班级分到各个工作表中

Dim i As Long , bj As String , rng As Range

i = 2

bj = Cells(i, "C" ).Value

Do While bj <> ""

' 将分表中A列第一个空单元格赋给rng

Set rng = Worksheets(bj).Range( "A65536" ).End(xlUp).Offset( 1 , 0 )

Cells(i, "A" ).Resize( 1 , 7 ).Copy rng ' 将记录赋值到对应的工作表中

i = i + 1

bj = Cells(i, "C" ).Value

End Sub

清除工作表内容

Sub shtClear()

Dim sht As Worksheet

For Each sht In Worksheets

If sht.Name <> " 成绩表" Then

sht.Range( "A2:G65536" ).ClearContents

End If

End Sub

8 、将工作表保存为新工作簿

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

Application.ScreenUpdating = True

End Sub

换种写法:

Sub 自动拆分工作表()

' 自动拆分工作表 宏

' 快捷键: Ctrl+m

' 把各个工作表以单独的工作簿文件保存在本工作簿所在的文件夹下的“拆分工作簿”文件夹下

Application.ScreenUpdating = False ' 关闭屏幕更新

Dim folder As String

folder = Application.ActiveWorkbook.Path & "\ 拆分工作簿"

'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

Application.ScreenUpdating = True

End Sub

9 、快速合并多表数据

Sub HeBing()

' 把各班级成绩表合并到“总成绩”工作表中

Rows( "2:25536" ).Clear ' 删除原有记录

Dim sht As Worksheet, xrow As Integer , rng As Range

For Each sht In Worksheets ' 遍历工作簿中所有工作表

If sht.Name <> ActiveSheet.Name Then

Set rng = Range( "A65536" ).End(xlUp).Offset( 1 , 0 ) ' 获得A列第一个空单元格

xrow = sht.Range( "A1" ).CurrentRegion.Rows.Count - 1 ' 记录分表中记录条数

sht.Range( "A2" ).Resize(xrow, 7 ).Copy rng ' 粘贴记录到汇总表

End If

End Sub

10 、汇总同文件夹下多个工作簿数

Sub HzwWb()

' 把目前下各个工作簿的信息汇总到同文件夹下的另一个工作簿的同一张工作表里

Dim r, c As Long

r = 1 ' 表头的行数

c = 8 ' 表头的列数

Range(Cells(r + 1 , "A" ), Cells( 65536 , c)).ClearContents ' 清空汇总表中原数据

Application.ScreenUpdating = False ' 关闭屏幕更新

Dim FileName As String , wb As Workbook, sht As Worksheet, Erow As Long , fn As String , arr As Variant

FileName = Dir (ThisWorkbook.Path & "\" & "*.xlsx" )

Do While FileName <> ""

If FileName <> ThisWorkbook.Name Then ' 判断文件是否是本工作簿

Erow = Range( "A1" ).CurrentRegion.Rows.Count + 1 ' 取得汇总表中第一条空行行号

fn = ThisWorkbook.Path & "\" & FileName

Set wb = GetObject (fn) ' 将fn代表的工作簿对象赋给变量

Set sht = wb.Worksheets( 1 ) ' 汇总的是第一张工作表

' 将数据表中的记录保存在arr数组里

arr = sht.Range(sht.Cells(r + 1 , "A" ), sht.Cells( 65536 , "B" ).End(xlUp).Offset( 0 , 8 ))

' 将数组arr中的数据写入工作表

Cells(Erow, "A" ).Resize( UBound (arr, 1 ), UBound (arr, 2 )) = arr

wb.Close False

End If

FileName = Dir ' 用Dir函数取得其他文件名,并赋值给变量

Application.ScreenUpdating = True ' 恢复屏幕更新

End Sub

11 、为工作表建立目录

Sub mkdir ()

' 为工作簿中所有工作表建立目录

Rows( "2:65536" ).ClearContents

Dim sht As Worksheet, irow As Integer

irow = 2

For Each sht In Worksheets ' 遍历工作表

Cells(irow, "A" ).Value = irow - 1 ' 写入序号

' 写入工作表名,并建立超链接

ActiveSheet.Hyperlinks.Add anchor:=Cells(irow, "B" ), Address:= "" , _

SubAddress:= "'" & sht.Name & "'!A1" , TextToDisplay:=sht.Name

irow = irows + 1 ' 行号加1

End Sub

转载自:https://www.cnblogs.com/wzh313/articles/9739085.html一、对象模型在VBE中“帮助(H)”——“Microsoft Visual Basic 帮助(H) F1”——“Visual Basic 语言参考”——“函数” 或者在VBE下快捷键“F1”地址:https://docs.microsoft.com/zh...