VBA学习笔记

2024年1月29日发(作者：)

.

EXCEL之VBA

学习笔记

姓名：刘磊

时间：2015年9

整理版

.

目录

第一章 VBA基础知识 .................................................................................................................................... 3

第二章 工作簿以及工作表的操作 ..................................................................................................... 9

第三章：单元格区域操作 ..................................................................................................................... 14

第四章：事件程序: .................................................................................................................................. 37

第五章：VBA数组 .................................................................................................................................. 45

整理版

.

第一章 VBA基础知识

1：代码帮助： F1

2：代码换行： 下划线+空格+回车

3：.常用代码操作excel中的对象

（1）、工作簿（Workbooks）

Workbooks（N）第N个工作簿

Workbooks ("工作簿名")

ActiveWorkbook 活动工作簿

ThisWorkBook 代码所在工作簿

（2）、工作表（Worksheets）

Sheets(N) 第N个工作表

Sheets("工作表名")

SheetN 第N个工作表

ActiveSheet 活动工作表

worksheets 与 Sheets的区别

（3）、 单元格（cells）

Range ("单元格地址")

Cells(行号,列号)

[A1]单元格简写

Activecell 活动单元格

Selection 当前被选取的区域

4：常量与变量

（1.）常量：常量是定义了之后就不做变化了。

常量定义格式：Const 常量名= 常量表达式

（2）.变量:在定义之后还能再次赋值

变量定义格式：Dim 变量 As 变量类型

5：数据类型

（1.）VBA中的常见数据类型：

类型 注释 简写 占用内存

Integer 整型 % 2Byte

Single 单精度 ! 4Byte

Double 双精度 # 8Byte

Long 长整型 & 4Byte

String 字符型 $ 定长或变长( 变长字符串最多可包含大约

20 亿 ( 2^31)个字符。 定长字符串可包含 1 到大约 64K ( 2^16 ) 个字符。)

整理版

.

Currency 货币型 @ 8Byte

6:if条件语句

1.单行形式1（If...Then）

If 条件判断 Then 条件成立结果

注意 在单行形式中，按照 If...Then 判断的结果也可以执行多条语句。

所有语句必须在同一行上并且以冒号分开?

例子:

Sub test()

If 1 > 10 Then a = a + 1: b = 1 + a: c = 1 + b

End Sub

2. 单行形式1（If 条件判断 Then 条件成立 Else 条件不成立）

例子:

Sub test2()

If 1 > 1 Then MsgBox "yes" Else MsgBox "no"

End Sub

3.块形式（If...Then…End）

If 条件判断 Then

条件成立结果

End If

例子:

Sub test3()

If 11 > 10 Then

a = 1 + a

b = 1 + a

c = 1 + b

End If

End Sub

4.块形式的If嵌套

If 条件判断 Then

成立时的结果

ElseIf 条件判断 Then

成立时的结果

……

整理版

.

Else

不成立时的结果

End If

例子:

Sub 等级判断()

If ("b1") >= 90 Then

("b2") = "优"

ElseIf ("b1") >= 80 Then

("b2") = "良"

ElseIf ("b1") >= 70 Then

("b2") = "中"

Else

("b2") = "差"

End If

End Sub

7：select语句用于判断选择

Select case

Case 1

Case 2

…..

Case else

End select

8：循环语句

（1）：do loop语句

Do

…..

Loop

(2):do while loop语句

Do while (条件成立时候循环)

Loop

（3）do until loop 语句

Do until (直到条件成立)

Loop

[注]：while与until不但可以放在DO后面，也可以放在LOOP后面事实上有时在循环的最后一行进行判断，更具有意义。

Do [{While | Until} 表达式]

[执行的一条或多条语句]

[Exit Do]

整理版

.

[执行的一条或多条语句]

Loop

---------------------------------------------------------------------------------

while：当这个条件为True时就 循环

until：直到这个条件为True时就 跳出循环

---------------------------------------------------------------------------------

或者可以使用下面这种语法:

Do

[执行的一条或多条语句]

[Exit Do]

[执行的一条或多条语句]

Loop [{While | Until}表达式]

---------------------------------------------------------------------------------

用Do…Loop循环要注意的几点:

1. While与Until是放在Do后面还是Loop后面，取决于是先判断再循环，还是先循环再判断。前者则在Do后面，后者则在Loop后面。

2. 可以在Do...Loop中的任何位置放置任意个数的 Exit Do 语句，随时跳出 Do...Loop 循环。

3. Do...Loop + If...Then + Exit Do 通常结合使用.

4. 如果 Exit Do 使用在嵌套的 Do...Loop 语句中，则 Exit Do 会将控制权转移到 Exit Do 所在位置的外层循环。

（4）：for each next 语句

Eg:

Sub foreachnext循环1()

Dim rng As Range, n! (range为单元格对象)

For Each rng In ("a2:a10") 取a2:a10中的每个单元格

If rng = "A1" Then ndex = 3

Next

End Sub

Sub foreachnext循环2()

Dim wsh As Worksheet, n As Byte, m As String （worksheet为工作表变量）

For Each wsh In Worksheets 取当前工作表集合中的每个成员

n = n + 1

(n, 3) =

Next

End Sub

9：exit语句与end语句

（1）： exit是退出当前语句

Do

For

Function

整理版

.

Sub

（2）：结束一个过程或块

End

End Function

End If

End Select

End Sub

[注]：end 有时候在某些地方的功能和exit for的作用相同。

10：跳转语句

GoTo line无条件地转移到过程中指定的行。

Gosub return 跳转到某行，而且能够返回。

注意太多的 GoTo 语句，会使程序代码不容易阅读及调试。尽可能使用结构化控制语句(Do...Loop、Next、If...Else、Select Case)。

For example

Sub gotoreturn()

Dim i!

For i = 2 To 10

If ("a" & i) > 1 / 3 Then GoSub 100

Next i

Exit Sub

100: (作为gosub的跳转标示符号)

("b" & i) = "迟到"

Return （return语句返回到跳转的地方）

End Sub

11：对错误语句的处理

方法1：

On Error Resume Next 当错误的时候继续执行下去

方法2：

On Error goto 当错误时候去哪儿。

12：with语句

当对某个对象执行一系列的语句时，不用重复指出对象的名称。

For example

Sub with嵌套1()

Range("a1").Value = "Who am i ?"

Range("a1"). = "Hello World"

整理版

.

Range("a1"). = 20

Range("a1"). = True

End Sub

Sub with嵌套2()

With Range("a1")

.Value = "Who am i ?"

. = "Hello World"

With .Font

.Size = 20

.Bold = True

End With

End With

End Sub

13:VBA 与公式

For example

Sub 普通公式()

(1, 3) = "=a1+b1"

End Sub

Sub 批量计算()

Dim i As Integer

For i = 1 To 10

(i, 4) = "=a" & i & "+b" & i

Next i

End Sub

Sub 数组公式()

Range("e1:e10").FormulaArray = "=a1:a10+b1:b10" (FormulaArray为数组公式)

End Sub

Sub 公式带引号的计算()

Cells(12, 1) = "=COUNTIF(A1:A10,"">9"")" （如果公式当中含有引号，则需要添加双重引号，才能够使公式的输入格式正确）

Cells(12, 2) = "=sum(INDIRECT(""a1:a10""))"

End Sub

14:运算符

运算符是代表VBA某种运算功能的符号。

1）赋值运算符 :=

2）数学运算符: &(字符连接符)、+(加)、-（减）、Mod（取余）、（整除）、*（乘）、/（除）、-（负号）、^（指数）

3）逻辑运算符:Not（非）、And（与）、Or(或)、Xor(异或 相同为0 ，不同为1)、Eqv(相等，相同为整理版

.

1，不同为0)、Imp(隐含)

4）关系运算符: = （相同）、<>（不等）、>（大于）、<（小于）、>=（不小于）、<=（不大于）、Like（判断两个字符串是否相同）

?：代表任何单一字符

*：代表零个或多个字符。

[charlist] ：代表charlist.中的任何单一字符?

[!charlist] ：代表不在 charlist 中的任何单一字符。

1：VBA 中工作表与工作簿的表示方法

1： workbooks(“工作表的文件名”)

Workbooks(“工作表的文件名”).parent 返回工作簿对象的父对象

2：工作簿引索号表示法

workbooks(数字).name 返回工作表的名称

3：窗口表示方法

返回当前excel工作簿打开的个数

Windows(N). 返回第N个工作簿的名称

[注：工作簿索引号的表示法与窗口表示法表示的工作簿的顺序相反。]

第二章 工作簿以及工作表的操作

2：当前工作簿与活动工作簿

当前工作簿：thisworkbook 代码所在工作簿

活动工作簿：activeworkbook 已经激活的工作簿

[注]：当前工作簿可能是已经激活的工作簿，也可能不是已经激活的工作簿。

3：工作簿的基本操作

workbooks由当前所有在内存中打开的workbook对象组成的集合

（1）：.新建工作簿

Sub 新建工作簿()

整理版

.

Dim wkb As Workbook 声明wkb为工作簿

Set wkb = 新建工作秒簿

"c:" 保存为工作簿

End Sub

（2）.打开工作簿

Sub 打开工作簿()

Dim wkb As Workbook

Set wkb = ("c:")

End Sub

（3）.关闭工作簿

Sub 关闭()

Workbooks("123").Close True (默认为自动保存，不提示)

End Sub

（4）.文件复制与删除

Sub 文件复制与删除()

FileCopy "c:", "c:" （对所有文件类型都起作用）

Kill "c:"

End Sub

4：工作薄的应用实例

（1） 判断文件是否存在

Sub 文件是否存在()

a = Dir("c:") （Dir函数用来取出路径下的目录文件）

If a = "" Then

MsgBox "不存在"

Else

MsgBox "存在"

End If

End Sub

（2） 打开指定目录下的文件

Sub 打开指定目录下的文件()

Dim a$, n!, wbs As Workbook

a = Dir("c:*.txt")

"c:" & a

Do

a = Dir

If a <> "" Then

"c:" & a

Else

Exit Sub

End If

整理版

.

Loop

End Sub

5：工作簿的表示方法

在workbook对象中，有一个SHEETS集合,其成员是worksheet对象或chart对象。

worksheets仅指的是工作表，而sheets包含图表，工作表，宏表等等

VBA中，经常在工作表之间转换或者对不同工作表中的单元格区域进行操作.

通常有下面几种方法:

（1）：Sub 直接使用工作表名称法()

MsgBox Worksheets("我的工作表").Name

MsgBox Sheets("我的图表").Name

End Sub

（2）Sub 索引号表示法()

MsgBox Worksheets(1).Name

End Sub

（3）Sub 工作表代码索引号表示法()

MsgBox Sheets(1).Name

End Sub

（4）Sub 直接取工作代码法()

MsgBox

End Sub

（5）Sub 活动工作表()

MsgBox

End Sub

注意：当工作簿包括工作表、宏表、图表等时，

使用索引号引用工作表如Sheets(1)与

WorkSheets(1)引用的可能不是同一个表。

Sub worksheetss()

MsgBox Worksheets(1).Name

MsgBox Sheets(1).Name

End Sub

Sub sheetss()

For i = 1 To

MsgBox Sheets(i).Name

Next

End Sub

6：工作表集合的应用

（1）Sub 遍历sheets下的所有对象()

For Each shs In Sheets

k = k + 1

Cells(k, 1) =

Next

整理版

.

End Sub

（2）Sub 遍历worksheets下的所能对象()

For Each shs In Worksheets

k = k + 1

Cells(k, 2) =

Next

End Sub

（3）Sub 工作表存在与否()

Dim sn$

For Each sht In Sheets

sn =

If sn = "我的工作表" Then

MsgBox "存在"

Exit Sub

End If

Next

MsgBox "不存在"

End Sub

（4）Sub 工作表存在与否1()

Dim sn$

For i = 1 To （指sheet里面的数量）

a = Sheets(i).Name

If Sheets(i).Name = "我的工作表" Then

MsgBox "存在"

Exit Sub

End If

Next

MsgBox "不存在"

End Sub

7：工作表的增加与删除

方法

表达式.Add(Before, After, Count, Type)

XlSheetType 常量之一:

xlWorksheet 工作表

xlChart 图表

xlExcel4MacroSheet 宏表

xlExcel4IntlMacroSheet 对话框

默认值为 xlWorksheet?

Sub 新建sheets()

整理版

.

（默认在活动工作表之前添加一个工作表）

Sheets("abc") （在工作表名为ABC的工作表之前添加一个工作表）

, Sheets("abc") （在工作表名为ABC的工作表之后添加一个工作表）

after:=Sheets("abc") （与上式等价）

Count:=2 （在活动工作表前添加两个工作表）

, , 2 （与上式等价）

, , , xlChart （添加图表）

End Sub

Sub 删除工作表()

End Sub

8：工作表的删除与添加

如果想批量新建工作表，可以结果循环来制作

Sub 新建1到12月份的工作表()

Dim j%

For j = 12 To 1 Step -1

= j & "月"

Next

End Sub

'删除工作表

Sub 删除sheet()

On Error Resume Next （当出现错误时候忽略错误）

yAlerts = False （当屏幕有警告提示时候忽略开启）

Dim i%

For i = 1 To 12

Sheets(i & "月").Delete

Next

yAlerts = True （当屏幕有警告提示时候忽略关闭，否则，下次运行代码时候依旧是忽略关闭状态）

End Sub

9：工作表的移动与复制

（1） 工作表的复制

表达式.copy(Before, After)

Sub 复制()

Sheets()

End Sub

（2） 工作表的移动

整理版

.

'表达式.Move(Before, After)

Sub 移动()

, Sheet3

End Sub

10：工作表的选择与激活

方法 不支持隐藏选取

te 方法 支持隐藏选取

（1）： Sub 快速选择所有工作表()

（只选择工作表）

（工作表，图表等全部选择）

End Sub

（2）：Sub 自定义选择()

Worksheets(Array(1, 3, 5)).Select

End Sub

11：拆分工作簿实例

Sub 拆分到工作簿()

Dim wk As Workbook, ss$, k% 声明wk为一个工作簿类型变量

yAlerts = False

For Each sht In Workbooks("2-11.工作簿综合运用(拆分工作簿)").Sheets

Set wk = wk为一个对象，对象的方法为添加工作表

k = k + 1

Workbooks(1).Sheets(k).Copy Workbooks(2).Sheets(1)

ss = & "" & & ".xlsx"

ss

Next

yAlerts = True

MsgBox "拆分工作簿完成！"

End Sub

第三章：单元格区域操作

整理版

.

1：range对象

单元格对象在VBA中一个非常基础，同时也很重要的。它的表达方式也是非常的多样化。

Range 对象

代表某一单元格、某一行、某一列、某一选定区域（该区域可包含一个或若干连续单元格区域），或者某一三维区域。

Range ("文本型装单元格地址")

range的常见写法

Sub rng()

Range("a1").Select 单元格

Range("a:a").Select 列

Range("1:3").Select 行

Range("a1:b10").Select 相邻区域

Range("a1:d7,c4:e8").Select 不相个邻区域

Range("a1:d7 c4:e8").Select 相交的区域

End Sub

2：range的其他写法

Range("a1:b10").Select '一般写法

Range("a1", "b10").Select '变化写法1

Range(Range("a1"), Range("b10")).Select '变化写法2 （方便以后可以使用变量替换）

Range("a1") = 123 （给单元格赋值）

注意：

1.如果在range前没有指定工作表，则默认为活动工作表

2.如果对象不是活动工作表（如活动图表），则会出现错误

Sub 单元格对象例子()

Range("a:a").Count '计数工作表最大的行数（意思是在活动窗口中显示出来）

Range("1:1").Count '计算工作表最大的列数

(Range("a:a")) '计算工作表已使用的行数

(Range("1:1")) '计算工作表已使用的列数

End Sub

3：range变量与引用

（1）：range的变化写法

1):range("地址区域").range("地址区域")

Sub 序号表示法()

Range("b2:d4").Range("b2").Select '相对引用的写法

'参照前一个range的左上单元格

整理版

.

End Sub

2): 地址区域中支持变量

Sub range的变量支持()

Dim a%

a = 3

Range("a" & a).Select

Range("c3:e5")(2).Select

End Sub

3):动态引用实例

Sub 实例1动态选单元格或区域()

Dim i%

i = (Range("c:c")) '找到c列中已使用的最后一个单元格位置

Range("c" & i).Select '选择C列最后一格

Range("a1", "c" & i).Select '选择A1到C列的最后一格（方法一）

Range("a1:c" & i).Select '选择A1到C列的最后一格（方法二）

小结：动态单元格区域的定位，可以应用到单据的保存等实际工作中

End Sub

4：Range引用与索引

range区域中的每个单元格，我们也可以用索引号表示出来

写法：range("单元格区域")(行号，列号)

Sub 索引号取出range的单元格()

'Range("a1:c4")(4).Select '引用顺序是：从左向右，从上到下选取

'Range("b2:c4")(3).Select '以前一个单元格区域为照

Range("a1:c4")(4.5).Select '当有小数时，则取整

'注意：如果索引号出现小数，则按照“四舍六入五单双”的“银行家舍入法”

End Sub

Sub 行列号定位()

Range("a1:c4")(3, 2).Select '利用行号与列号定位

Range("a1:c4")(1.5, 2.5).Select '行列号也可以使用小数

5：cells单元格的引用

cells单元格引用法

写法：cells(行号,列号)

Sub cells基本写法()

Cells(3, 4).Select '行列号均为数字

Cells(2, "c").Select '行为数字，列为列标字母

'全选

End Sub

'cells可以像range一样可以参照前面的单元格位置

Sub 参照写法()

Range("b3:f11").Cells(2, 2).Select

Range("b3:f11").Cells(6).Select '从左到右，从上到下

整理版

.

Range("b3:f11")(6).Select '与上一句相等

End Sub

'注意：

'中的数字一样支持正数，负数，0值，小数(四舍六入五单双)

'不能像range一样可以引用一个区域，只能引用一个单元格

6：单元格简写

除了前面讲的rangecells单元格区域的表示方法还，还是一种简单的写法

'写法: [单元格地址] '注意：中括号中的单元格地址并不需要双引号("")

Sub 单元格简写()

[a3].Select ' 单元格引用

[b2:c6].Select '单元格区域引用

[a3,b2:c6,b8:d12].Select '多区域引用

[a:a].Select '整列引用

[1:1].Select '整行引用

End Sub

'单元格简写的也支持引用子集

Sub 子集引用()

[b2:c6].Item(3).Select

Range("b2:c6")(3).Select

[b2:c6].Cells(4).Select

End Sub

Sub 动态区域的引用()

a = ([a:a])

b = ([1:1])

Range(Range("a1"), Range(Chr(64 + b) & a)).Select '利用chr函数，让字母形式的列号也支持变量

End Sub

Sub chr函数字符循环()

For i = 1 To 65535

Cells(i, 1) = i

Cells(i, 2) = Chr(i)

Next

End Sub

7：三种单元格引用小结

功能

引用对象

变量支持

书写难易

Range

单元格，区域，行，列

支持

难

Cells

单元格

支持

难

[单元格地址]

单元格，区域，行，列

不支持

易

Range("a1:c" & i).Select '引用单元格是区域且有变量

整理版

.

Cells(i, "c").Select '引用的是单个单元格且有变量

[a1:19].Select '引用的是区域或单元格且无变量

8：行列的引用

'行列引用

Sub 列引用()

Columns(1).Select

Columns("b").Select （b列）

Columns("c:e").Select （c到e列）

End Sub

Sub 行引用()

Rows(1).Select

Rows("2").Select

Rows("3:4").Select （3到4行）

End Sub

Sub range行列表式法()

Range("1:1").Select （第一行）

Range("2:4").Select （2到4行）

Range("a:a").Select （a列）

Range("b:d").Select （B到D列）

End Sub

Sub 简写法()

[a:a].Select

[b:d].Select

[1:1].Select

[2:4].Select

End Sub

Sub 全选()

'选择所有行

'选择所有列

'选择所单元格

i =

j =

k =

End Sub

Sub 动态引用使用区域()

a = (Columns(1)) （返回第一列当中使用的（非空）单元格数目）

b = (Rows(1)) （返回第一行中使用的（非空）单元格数目）

Range("a1", Cells(a, b)).Select （动态引用单元格）

End Sub

9: row与column属性

整理版

.

属性

'返回区域中第一个子区域的第一行的行号

' 属性

'返回指定区域中第一块中的第一列的列号

Sub test()

i = Range("a3:b9").Range("a5").Row （返回A3到B9区域的第一行第五列所在单元格位置的真实行号）

j = Range("a3:b9").Row

i = Range("b3:d9").Range("a5").Column

j = Range("b3:d9").Column

End Sub

实例：

Sub row应用()

For Each rw In Rows("1:13")

If Mod 2 = 0 Then

ght = 5 （将偶数行的行高设置为5，其中mod为求余函数）

End If

Next rw

End Sub

10：单元格的地址与值

单元格的值表示方法

Sub 单元格值表示()

a = [a1].Value '实际是什么，就是什么

b = [a1].Text '看到是什么，就是什么

c = [a1]

End Sub

'注意：一个单元格可以省略value，多单元格区域不能省略

Sub 多区域赋值()

Range("e1:e4") = Range("d1:d4").Value

End Sub

'单元格地址与引用

Sub 地址与引用()

Set rng = [b2:f2]

[a9] = s(1, 1) '绝对引用

[b9] = s(0, 0) '相对引用

[c9] = s(1, 0) '混合引用

[d9] = s(0, 1) '混合引用

End Sub

'总结：1代表固定（绝对引用），0代表不固定,默认是绝对引用

整理版

.

Sub 地址引用实例()

'将表三成绩中为空的单元格标为未考

Dim rng As Range, rn$

On Error Resume Next

For Each rng In ("b2:d10")

If rng = "" Then rn = rn & s & ","

Next

Range(Left(rn, Len(rn) - 1)) = "未考" （left函数返回从左开始取字符串中, Len(rn) – 1长度个字符）

End Sub

11：单元格的移动与复制

'------------------------------------------------------------

' 方法

'将单元格区域剪切到指定的区域

' 方法

'将单元格区域复制到指定的区域 （会复制该单元格的值和格式）

Sub 移动复制()

Range("a1:d8").Cut Range("f1")

Range("f1:i8").Copy Range("a1")

End Sub

（利用单元格赋值的方法也可以完成复制操作，在此方法中只会复制单元格的值，不会复制格式）

Sub 另类复制方法()

Range("a10:d17") = Range("a1:d8").Value

End Sub

'注：

'1.等号后的区域一定要加value.否则不成功

'2.被赋值的区域格式全部去掉

12：工作表中单元格的删除与插入

'工作表中单元格，行与列的插入与删除

Sub 插入()

Rows(2).Insert

End Sub

Sub 隔行插入()

Dim r%

Do

r = r + 2

Rows(r).Insert

Loop Until Cells(r + 1, 1) = ""

End Sub

整理版

.

Sub 删除()

Rows(1).Delete

End Sub

Sub 隔行删除()

Dim r, s

m = (Columns(1))

For r = 1 To m / 2

Rows(r).Delete

Next

End Sub

13：活动单元格与选择区域

活动单元格：activecell,工作表中活动单元格只有一个

Sub activecells()

a = s '取得活动单元格地址

Cells(2, 3).Activate '激活指定单元格

End Sub

'selection光标所选区域

Sub 光标所选区域()

Selection = 1 （光标所选区域的每一个单元格的值赋为1）

End Sub

Sub 在selection中的改变活单元格()

For i = 1 To

Selection(i).Activate （激活所选区域单元格）

Next

End Sub

Sub 运用()

Dim i As Range

For Each i In Selection

If i = "" Or i = "缺勤" Then

i = "×"

End If

Next i

End Sub

'小结：selection的好处在于，可以很自由灵活选择你想要处理的单元格区域

14： UsedRange已使用区域(条件统计)

'nge 属性

'返回一个 Range 对象，该对象表示指定工作表上所使用的区域

整理版

.

Sub 已使用区域()

End Sub

'注意：

'已使用区域的定位方法是：已使用的最小单元格：最大单元格

'如果单元格中无内容，但设定了格式，也认为是已使用区域

'如果没有已使用单元格，则默认为A1单元

Sub usedrange应用()

For Each Rng In nge

If IsNumeric(Rng) And Rng >= 90 Then k = k + 1

Next Rng

MsgBox "大于等于90分的人数为：" & k & "人"

End Sub

'小结：

'nge自动计算已用区域的所有值

'2.不用当数据增加时的处理问题。

'3.比selection方便，但不够灵活

15： currentregion属性

'tRegion 属性

'返回一个 Range 对象，该对象表示当前区域。（返回以当前单元格说扩展后的单元格区域）

Sub 当前区域()

[a1].

[f8].

End Sub

Sub currentregion应用()

Rows(8).Clear

a = [b2].s

b = [b5].s

c = [b2]. + 1

Set c = Range("b8", Cells(8, c))

aArray = "=" & a & "+" & b （此为一数组公式，formulaArray为数组公式）

End Sub

'usedrange与currentregion

'如果表中只有一个区域，两者最后的结果是一样的

'只是表达方式不一样

Sub u与c()

[a1].

End Sub

整理版

.

16：单元格的offset（偏移）属性

' 属性

'返回 Range 对象，它代表位于指定单元格区域的一定的偏移量位置上的区域。

'表达式.Offset(偏移行, 偏移列)

'表达式 一个代表 Range 对象的变量。

'偏移行列的数字可以是：正数，负数，零值

Sub test()

[a1].Offset(1, 2).Select '行列都偏移

[a1].Offset(2).Select '只偏移行

[a1].Offset(, 2).Select '只偏移列

'如果offset前面的range对象是一个区域，则偏移后也结果尺寸不变

[a1:d1].Offset(1, 2).Select

[a1:d1].Offset(2).Select

[a1:d1].Offset(, 2).Select

End Sub

Sub offset应用1()

Dim i%

For i = 2 To 8 Step 2

[a1:e1].Copy [a1:e1].Offset(i)

Next i

End Sub

Sub offset应用2()

Dim i%

For i = 2 To 8 Step 2

[a1:e1].Offset(i) = ""

Next i

End Sub

17：单元格的resize属性(单据数据保存)

' 属性

'调整指定区域的大小。返回 Range 对象，该对象代表调整后的区域。

'语法

'表达式.Resize(行数, 列数)

'表达式 一个返回 Range 对象的表达式。

Sub test()

[a1].Resize(2, 3).Select

[a1].Resize(2).Select

[a1].Resize(, 3).Select

End Sub

Sub 保存()

整理版

.

Dim i%, j%, k%

i = [a1]. - 1

j = [a1].

k = (s(1))

[a2].Resize(i, j).Copy Sheet2.[a1].Offset(k)

End Sub

18：单元格所在的行和列

'Row 属性

'返回一个 Range 对象，该对象表示包含指定区域的整行（或多行）。

'语法

'表达式.EntireRow

'表达式 一个代表 Range 对象的变量。

'Column 属性

'返回一个 Range 对象，该对象表示包含指定区域的整列（或多列）

'语法

'表达式.EntireColumn

'表达式 一个代表 Range 对象的变量。

Sub test()

[a1].

[a1].

[a1:a4].

[a1:d1].

End Sub

Sub test1()

Dim rng As Range, ads As String

For Each rng In [a1:a10]

If rng = "" Then ad = ad & s & ","

Next

ads = Left(ad, Len(ad) - 1)

Range(ads).

End Sub

19：定位条件

'lCells 方法

'返回一个 Range 对象，该对象代表与指定类型和值匹配的所有单元格。

'语法

'表达式.SpecialCells(Type, Value)

'表达式 一个代表 Range 对象的变量。

整理版

.

Sub 批注汇总()

MsgBox (lCells(-4144))

End Sub

Sub 删除空行()

On Error GoTo 100

lCells(xlCellTypeBlanks).Select

Exit Sub

100:

MsgBox "没有空行"

End Sub

20：find查找方法

' 方法

'在区域中查找特定信息

'语法

'表达式.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte,

SearchFormat)

'表达式 一个代表 Range 对象的变量。

Sub 查找最后一个单元格()

Set endrng = ("*", , xlFormulas, , , xlPrevious)

Range([a1], endrng).Select

End Sub

21：find查找系统

'

Sub 查询系统()

ends = Columns(1).Find("*", , , , , searchdirection:=xlPrevious).Row '动态找到MatchByte

A列的最后一个单元格

Range("g3:l999").Clear '清除之前所有的筛选结果

For Each Rng In Range("a2:a" & ends)

m = m + 1

If Rng Like Range("h1") Then '如果条件成立，那么

k = k + 1

Range("a" & m + 1 & ":e" & m + 1).Copy Range("g" & k + 2) '将记录复制到另一个区域

End If

Next

End Sub

TRUE:区分

22：进销存之入库单

整理版

.

Sub 开单()

Set es = ("*", , xlFormulas, , , xlPrevious)

a = s

[b2] = "SM" & Format(Now(), "ymdhms")

Range([a5], (4)) = ""

[e2] = ""

End Sub

Sub 保存()

On Error GoTo 100

Dim es As Range, a%

If Sheet2.[f:f].Find([b2]) = [b2] Then

MsgBox "已经保存过了!"

Else

100:

Set es = ("*", , xlFormulas, , , xlPrevious)

a = (Sheet2.[a:a])

If = 4 Then MsgBox "没有填写内容": End

Range([a5], es).Copy (a + 1, 1)

(a + 1, "f").Resize( - 4) = [b2] '保存入库单

(a + 1, "g").Resize( - 4) = [e2] '保存供应商

(a + 1, "h").Resize( - 4) = Now() '保存日期时间

MsgBox "保存成功!"

End If

End Sub

Sub 计算()

Set es = Columns(3).Find("*", , xlFormulas, , , xlPrevious)

For Each Rng In Range([c5], es)

(0, 2) = (0, 1) * Rng

Next

End Sub

23：单元格end属性

Sub 宏5()

(xlDown).Select

(xlToRight).Select

(xlUp).Select

(xlToLeft).Select

End Sub

Sub 分期付款最后月()

i = Cells(, 1).End(xlUp).Row '找到A列的最后一行的行号

Range("n2", Cells(i, "n")) = "" '将最后付款月下的区域清空

For j = 2 To i

整理版

.

k = Cells(j, "n").End(xlToLeft).Column '找到最后付款月所在的列号

Cells(j, "n") = Cells(1, k) '将对应的月份填入对应的单元格

Next j

End Sub

24：查找最后一个单元格的N种方法

'这里讨论怎样找到最后一个单元格！

'不考虑最后量个单元格是：是公式，错误值，隐藏之类的特殊情况。

'以最后是一个常规的值为准。且以A列的最后一个单元格为准

'---------------------------------------------------------------

Sub 最后的单元格()

a = Cells(, 1).End(xlUp).Row 'end属性

b = Columns(1).Find("*", , , , , xlPrevious).Row 'find方法

c = lCells(xlCellTypeLastCell).Row 'specialcells方法

d = 'usedrange属性

e = [a1]. 'currentregion属性

f = ([a:a]) '工作表函数counta

g = f([a:a], "<>") '工作表函数countif

End Sub

25：单元格的合并

' 方法

'返回两个或多个区域的合并区域

'

Sub test()

Range("a1:b3,c5:d8").Select '文本地址引用方式

Union([a1:b3], [c5:d8]).Select '单元格区域引用方式

End Sub

'小结：虽然range也可以完成多区域的引用

'但文本地址的引用方式最多不能超过256个字符

'而union却没有这个限制

'我们经常利用变量与union进行单元格的连接

Sub 连接符单元格连接()

Dim rng As Range

For Each rngs In [b2:b10]

adss = s

ads = ads & s & ","

Next

ad = Left(ads, Len(ads) - 1)

End Sub

整理版

.

Sub union单元格连接()

Dim rng As Range, rngs As Range

Set rng = [b2]

For Each rngs In [b2:b10]

adss = s

Set rng = Union(rng, rngs)

ads = s

Next

End Sub

26：单元格的交集

'ect 方法

'返回一个 Range 对象，该对象表示两个或多个区域重叠的矩形区域。

Sub test()

If Intersect([a1:d10], Selection) Is Nothing Then '注释：Is Nothing 用于判断对象是否存在，对象可以是工作簿，工作表，单元格区域等

MsgBox "没有交集"

Else

MsgBox Intersect([a1:d10], Selection).Address

Intersect([a1:d10], Selection).Select

End If

End Sub

Sub 隔行插入()

For i = 0 To (Columns(1)) * 2 Step 2

Intersect([a1:d2].Offset(i), [a2:d3].Offset(i)).

Next

End Sub

27：单元格数字格式的设置代码

'FormatLocal 属性

Sub 获取单元格设置数字格式()

For Each Rng In [a1:a3]

Cells(, 2) = FormatLocal '获取单元格的格式代码

Next Rng

End Sub

Sub 给单元格设置数字格式()

For Each Rng In [a1:a3]

FormatLocal = "0.00"

Next Rng

整理版

.

End Sub

Sub 保存1111()

Set es = ("*", , xlFormulas, , , xlPrevious)

a = (Worksheets("记录保存").[a:a])

Range([a5], es).Copy Worksheets("记录保存").Cells(a + 1, 1)

With Worksheets("记录保存")

.Cells(a + 1, "f").Resize( - 4) = [b2] '保存入库单

.Cells(a + 1, "g").Resize( - 4) = [e2] '保存供应商

.Cells(a + 1, "h").Resize( - 4) = Now() '保存日期时间

.Cells(a + 1, "h").Resize( - 4).NumberFormatLocal = "e-m-d aaaa"

End With

MsgBox "保存成功!"

End Sub

28：单元格字体格式设置代码实现

'Font 对象

'包含对象的字体属性（字体名称、字号、颜色等等）。

'ormats 方法

'清除对象的格式设置

'常见font对象的属性

Sub font对象属性()

With [a2:a6].Font

.Name = "微软雅黑" '字体

.Size = 8 '字号

.Bold = True '加粗

.Color = RGB(255, 0, 255) '颜色

End With

End Sub

Sub 大于90分的颜色设置为红色()

Set i = Cells(, 3).End(xlUp)

Range([b2], i).ClearFormats

For Each Rng In Range([b2], i)

If >= [f1] Then

With

.Name = "华文琥珀"

.Size = 20

.Bold = True

整理版

.

.Color = RGB(255, 0, 0)

End With

End If

Next Rng

End Sub

29：底纹颜色的设置

'Interior 对象

'代表一个对象的内部

'针对interior对象，我们用得最多的是它的颜色，下面就来讨论一下。

Sub 索引颜色值()

For i = 1 To 56

Cells(i, 1).ndex = i

Cells(i, 2) = i

Next i

End Sub

Sub 早期颜色值()

For i = 0 To 15

Cells(i + 1, 1). = QBColor(i)

Cells(i + 1, 2) = i

Next i

End Sub

Sub 三原色颜色值()

Cells(2, 4). = RGB([a1], [b1], [c1])

End Sub

Sub 直接颜色值() '此颜色有255^3种颜色

Cells(1, 1). = [b1]

End Sub

30：单元格格式设置实例

Sub 格式化工资条()

Dim i%

i = Cells(, 1).End(xlUp).Row

For j = 1 To i

If j Mod 2 Then

With Cells(j, 1).("a1:g1").Font

.Bold = True

整理版

.

.Size = 8

.ColorIndex = 56

End With

Else

With Cells(j, 1).("a1:g1").Interior “以本行第一个单元格为坐标的A1：G1”区域

.ColorIndex = 40

End With

End If

Next j

End Sub

Sub 清除格式化()

ormats

End Sub

31：利用查找颜色功能拾取颜色求平均

Sub 根据查找功能拾取的颜色求平均()

On Error GoTo 100

Dim erng As Range, rng As Range, i As Long

i = （利用查找颜色的功能返回拾取的颜色）

Set erng = Cells(, "e").End(xlUp)

For Each rng In Range([b2], erng)

If = i Then k = k + : n = n + 1

Next

MsgBox "最后平均分为：" & k / n & "分"

End

100:

MsgBox "查找功能没有拾取到颜色！"

End Sub

32：粘贴

Option Explicit

' 方法

'将“剪贴板”中的内容粘贴到工作表上。

'表达式.Paste(Destination, Link)

'表达式 一个代表 Worksheet 对象的变量。

Sub 粘贴()

Range("B1:B6").Copy Range("c9")

Range("B1:B6").Copy '复制区域无公式

Range("c9") '粘贴到c4单元格

整理版

.

End Sub

Sub 粘贴2()

Range("c1:c6").Copy '复制单元格有公式

'如果不指定 Destination 参数，则在使用该方法之前必须选择目标区域。

End Sub

Sub 粘贴1()

Range("c1:C6").Copy '复制c1单元格

, True '

yMode = True

End Sub

33：选择性粘贴

Option Explicit

'pecial 方法

'将 Range 从剪贴板粘贴到指定的区域中。

'语法

'表达式.PasteSpecial(Paste, Operation, SkipBlanks, Transpose)

'表达式 一个代表 Range 对象的变量。

Sub 选择怪粘贴()

Range("c2:c10").Copy

Range("d2").PasteSpecial 12

End Sub

Sub 选择怪粘贴运算()

Range("b2:b9").Copy

Range("d2").PasteSpecial , 2

Range("c2:c9").Copy

Range("d2").PasteSpecial , 2

End Sub

Sub 选择怪粘贴跳过空单元()

Range("b2:b9").Copy

Range("e2").PasteSpecial , , True

End Sub

Sub 选择性粘贴转置()

整理版

.

Range("a2:b9").Copy

Range("a11").PasteSpecial 12, , , True

End Sub

34：合并单元格

Option Explicit

' 方法

'由指定的 Range 对象创建合并单元格。

Sub 合并单元格()

End Sub

整理版

.

Sub 合并单元格实例()

Dim er%, rng%, rg As Range

yAlerts = False

er = ([a:a])

For rng = er To 2 Step -1

Set rg = Range("a" & rng)

If rg = (-1) Then (-1).Resize(2).Merge

Next

yAlerts = True

End Sub

35：合并单元格实例与取消合并单元格

'-----------------------------------------------------------------------

'rea 属性

'返回一个 Range 对象，该对象代表包含指定单元格的合并区域。

'e 方法

'将合并区域分解为独立的单元格

'--------------------------------------------------------------------------

Sub test()

a = Range("a1").

[a1].UnMerge

End Sub

Sub 解除合并单元格后保持原来的数据()

Dim b%, rng As Range

For Each rng In Selection

b =

e

(b) = rng

Next

End Sub

36：有条件的添加批注

'Comment 对象

'代表单元格批注

'批注添加

Sub 批注添加()

With [a1]

If .Comment Is Nothing Then

整理版

.

. "123"

.e = True

End If

End With

End Sub

Sub 删除批注()

For Each Rng In Selection

If Not t Is Nothing Then

omments

End If

Next

End Sub

Sub 批量添加批注()

For Each Rng In Range("a2:a20")

omments

If Rng >= 90 Then "优秀"

Next

End Sub

37：修改批注（注意文件地址的书写方式）

'修改批注

Sub 修改批注()

Range("a2").AddComment '添加批注

[a2]. = 50 '设置批注高度

[a2]. = 40 '设置批注宽度

[a2].cture & "7pic阿汤.png"

End Sub

Sub 批量将批注增加背景()

For Each Rng In Selection

paths = & "7pic" & & ".png"

omments

ment

= 50

= 40 '设置批注宽度

cture paths

Next

End Sub

38：图形基础

'Shapes 对象

'指定的工作表上的所有 Shape 对象的集合。

整理版

.

'说明

'每个 Shape 对象都代表绘图层中的一个对象，如自选图形、任意多边形、图片、图表等。

Sub abc()

Dim ob As Shape

n =

For Each ob In

k = k + 1

Cells(k + 1, "f") = '图形名称

Cells(k + 1, "g") = '图形类型

Cells(k + 1, "h") = '顶端坐标

Cells(k + 1, "i") = '左端坐标

Cells(k + 1, "j") = '宽度

Cells(k + 1, "k") = '高度

Next ob

End Sub

Sub 图形插入()

ture & "7pic林志玲.png", _

True, True, 100, 100, 70, 70

End Sub

Sub 图形删除()

For Each shp In

Next shp

End Sub

39：图形的插入应用实例

Sub 宏1()

For Each shap In

If <> 8 Then

Next shap

For Each Rng In Range([a2], Cells((Columns(1)), 1))

i = & "7pic" & Rng & ".png"

Set rngs = Cells(, 2)

ture i, True, True, , , ,

Next Rng

End Sub

40：多表合并

整理版

.

'Option Explicit

Sub 多表合并()

Dim i%, rs%, rss%, st As Worksheet, zst As Worksheet

Set zst = Sheets("1季度") '将汇总工作表"1季度"定义为变量zst

For i = 1 To 3

Set st = Sheets(i & "月") '将1-3每月的工作表定义为变量st

rs = ' 计算1-3月份每个表的最后一行

rss = + 1 '计算“1季度的最后一行的下一行”

("a2:b" & rs).Copy (rss, 1) '复制1-3表的数据到总表中

(rss, 3).Resize(rs - 1) = i & "月" '将1-3表的工作表名写入到总表对应的记录中

Next

End Sub

41：多表拆分

Sub 多表拆分()

For f = 1 To 3 '循环三次（只拆分三个月）

= f & "月" '新建工作表，并以月份命名

For Each Rng In Sheets("总表").Range("a2:a15")

If = f & "月" Then '如果a列的值等于当前的月份

n = "a" & & ":d" & '构造被复制的源表区域

y = y + 1 '新表行数累计

If y = 1 Then

Sheets("总表").Range("a1:d1").Copy Sheets(f & "月").Cells(y, 1)

End If

Sheets("总表").Range(n).Copy Sheets(f & "月").Cells(y + 1, 1) '则将当前月份所在行复制到新建月份表中

End If

Next

y = 0 '分表行数累计归零

Next

End Sub

第四章：事件程序:

1：事件程序定义与作用

'1.定义

'excel事件程序：因为一个操作(动作)而触发了一段程序。让程序发生了运行。

'就像机关设置

整理版

.

'2.实例

'例1：打开工作表1，则运行一段程序（选择工作表1触发程序）

'例2：保护工作表数据实例。

'3.作用

'excel事件程序的作用：以前程序只能通过手工运行或指定宏功能来完成

'事件程序则可以却因不同的操作而自动触发运行不同的程序。

'4.代码位置

'excel事件程序代码存放在位置

'-----------------------------------

'事件类型 代码位置

'-----------------------------------

'工作表事件 工作表

'工作簿事件 工作簿(thisworkbook)

'程序事件 工作簿(thisworkbook)或类模块

2：事件程序基础

'代码存储位置

'事件 代码位置

'-------------------------------------------------------

'应用程序-根据应用程序的动作进行控制 类模块或thisworkbook 对所有工作簿操作的相关事件

'工作簿-根据工作簿的动作进行控制 thisworkbook 对所有工作表操作的相关事件

'工作表-根据工作表的动作进行控制 2.... 对工作表中所有单元操作的相关事件

'2.括号里面是参数(传回值用法)

'target:传递单元格对象（例子：禁止选择）

'sh:传递工作表对象（例子：新建工作表时提示更改名称）

'3.代码保护

整理版

.

'方法:工具-VBAProject属性-保护

应用程序事件

NewWorkbook

SheetActivate

SheetBeforeDoubleClick

SheetBeforeRightClick

SheetCalculate

SheetChange

SheetDeactivate

SheetFollowHyperlink

SheetPivotTableUpdate

SheetSelectionChange

WindowActivate

WindowDeactivate

WindowResize

WorkbookActivate

WorkbookAddinInstall

WorkbookAddinUninstall

WorkbookAfterXmlEmport

WorkbookAfterXmlImport

WorkbookBeforeClose

WorkbookBeforePrint

WorkbookBeforeSave

WorkbookBeforeXmlExport

WorkbookBeforeXmlImport

WorkbookDeactivate

WorkbookNewSheet

WorkbookOpen

WorkbookPivotTableCloseCloseConnection

注释

当新建一个工作簿时发生此事件

当激活任何工作表时发生此事件

在双击任何工作表前发生此事件

右键单击任何工作表前发生此事件

在重新计算工作表时发生此事件

更改任何工作表的单元格时发生此事件

当工作表失去焦点时发生此事件（离开工作表时）。

在单击工作簿中的任何超链接时发生。

在更新数据透视表的工作表后发生。

所选内容在任何工作表上更改时发生。

在激活任何工作簿窗口时发生。

工作簿的窗口变为非活动状态时，将产生本事件。

改变工作簿窗口大小时发生

当激活任何工作簿时发生此事件

工作簿为加载宏安装时发生此事件

当任一工作簿作为卸载宏时发生

在保存或导出工作簿中的XML数据之后发生此事件

当刷新现有的XML数据链接或新的XML数据被导入任一打开的Excel工作簿之后时发生

关闭任何工作簿前发生此事件

在打印工作簿前发生此事件

在保存任何工作簿前发生引事件

保存或导出XML数据前发生的事件

当刷新现有的XML数据链接或新的XML数据被导入任一打开的Excel工作簿之前时发生

当打开的工作簿转为非活动状态时发生此事件

在任何打开的工作簿中新建工作表时发生此事件

当打开一个工作簿时发生此事件

在数据透视表的链接关闭之后发生此事件

如果用户在OLAP数据透视表上深化记录集或调用行集操作，则会发生WorkbookRowsetComplete事件

此事件

注释

激活工作簿、工作表、图表工作表或嵌入式图表时发生此事件

当工作簿作为加载宏安装时，发生此事件

当工作簿作为加载宏卸载时，发生此事件

在Excel保存或导出指定工作簿中的XML数据之后发生此事件

在刷新现有的XML数据链接或将新的XML数据导入到指定的Excel工作簿之后，发WorkbookPivotTableOpenCloseConnection 在数据透视表的链接打开之后发生此事件

WorkbookRowsetCompletd

Workbooksync

工作簿事件

Activate

AddinInstall

AddinUninstall

AfterXmlExport

AfterXmlImport

当作为“文档工作区”一部分的工作簿的本地副本与服务器上的副本进行同步时发生整理版

.

生此事件

BeforeClose

BeforePrint

BeforeSave

BeforeXmlExport

BeforeXmlImport

Deactivate

NewSheet

Open

PivotTableCloseConnection

PivotTableOpenConnection

RowsetComplete

SheetActivate

SheetBeforeDoubleClick

SheetBeforeRightClick

SheetCalculate

SheetChange

SheetDeactivate

SheetFollowHyperlink

SheetPivotTableUpdate

SheetSelectionChange

Sync

WindowActivate

WindowDeactivate

WindowResize

工作表事件

Activate

BeforeDoubleClick

BeforeRightClick

Calculate

Change

Deactivate

FollowHyperlink

PivotTableUpdate

SelectionChange

是否保存更改之前产生。

在打印指定工作簿（或者其中的任何内容）之前，发生此事件

保存工作簿之前发生此事件

在Excel保存或导出指定工作簿中的XML数据之后发生此事件

在刷新现有的XML数据链接或将新的XML数据导入到指定的Excel工作簿之后，发生此事件

图表、工作表或工作簿被停用时发生此事件

当在工作簿中新建工作表时发生此事件

打开工作簿时，发生此事件

数据透视表关闭与其数据源的链接后发生此事件

数据透视表打开与其数据源的链接后发生此事件

如果用户在OLAP数据透视表上深化记录集或调用行集操作，则会引发此事件

当激活任何工作表时发生 此事件

当双击任何工作表时发生此事件，此事件先于默认的双击操作发生

右键单击任一工作表时发生此事件，此事件先于默认的右键单击操作

在重新计算工作表时或在图表上绘制更改的数据之生发生此事件

当用户或外部链接更改了任何工作表中的单元格时发生此事件

当任何工作表停用时发生此事件

单击Excel中的任何超链接时发生此事件

在数据透视表的工作表更新之后发生此事件

任一工作表的选定区域发生更改时，将发生此事件

生此事件

工作簿窗口被停用时发生此事件

任何工作簿窗口调整大小时发生此事件

任何工作簿窗口被停用时发生此事件

注释

激活工作簿，工作表，图表等发生的事件

在工作表中双击前发生的事件

右键单击工作表前发生的事件

工作表重新计算之后发生的事件

更改工作表中的单元格发生的事件

工作表，图表停用（焦点离开）时发生的事件

单击工作表上的任意超链接时，发生此事件

工作簿中的数据透视表更新后发生此事件

当工作表上选定区域发生改变时发生此事件

在关闭工作簿之前，先产生此事件。如果该工作簿已经更改过，则本事件在询问用户当作为“文档工作区”一部分的工作表的本地副本与服务器上的副本进行同步时，发3：工作表事件实例1（自选计算与投票统计）

整理版

.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim rs

rs = (Columns(1))

If s = Range("a1:a" & rs).Address Then

For i = 1 To rs

Cells(i, 2) = "=" & Cells(i, 1)

Next

End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error Resume Next

If s = "$A$3" Or s = "$B$3" _

Or s = "$C$3" Or s = "$D$3" Then

= + 1

End If

End Sub

4工作表事件实例2

'当选择的单元格地址显示在状态栏上方法一

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Bar = "当前选择的区域是：" & s(0, 0)

End Sub

Private Sub Worksheet_Deactivate()

Bar = ""

End Sub

'当选择的单元格地址显示在状态栏上方法一

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Bar = "当前选择的区域是：" & s(0, 0)

End Sub

Private Sub Worksheet_Deactivate()

Bar = "当前选择的区域是："

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If <> "成绩表" Then = "成绩表"

End Sub

5：工作表事件实例（自动列出工作表名与单元格区域保护）

Private Sub Worksheet_Activate()

For Each sht In Sheets

If <> "全年月份" Then

整理版

.

k = k + 1

Sheets("全年月份").Cells(k, 1) =

End If

Next

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Intersect(Target, [a1:c12]) Is Nothing Then

MsgBox "你只能在[a1:c12]区域中工作！"

[a1].Select

End If

End Sub

6：工作簿事件实例1（自动选择月份表、右键禁用、打印控制）

'事件中的Cancel:

' 默认为false，在完成事件内代码效果后，接着继续完成操作的后续效果。

' 而为true时，在完成事件内代码效果后，终止当前操作的后续效果。

' 相当于给用户控制事件提供一个开关。可以把用户自定义事件代替默认事件

' 没有Cancel就是说不给你这个控制权限，一旦一始就要按流程结束。

Private Sub Workbook_Open()

mon = Format(Now(), "m")

Sheets(mon & "月").Select

End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As

Boolean)

Cancel = True '禁用右键

End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)

If Month(Now()) & "月" <> Then

MsgBox "不能打印"

Cancel = True

Else

MsgBox "能打印"

Cancel = False

End If

整理版

.

End Sub

7：工作簿事件实例2（给工作表加密码）

'Events 属性

'Events = True/FALSE

'如果对指定对象启用事件，则该属性值为 True。Boolean 类型，可读写。

'作用：临时关闭，防止死循环

'Private Sub Workbook_Open()

'Events = True

' = RGB(255, 255, 255)

'te

'End Sub

Private Sub Worksheet_Activate() '激活工作表触发的程序

a = InputBox("请输入密码")

If a = 123 Then

= RGB(0, 0, 0)

Events = False

Else

te

End If

End Sub

8：应用程序事件

'应用程序事件：是对每个打开工作簿操因操作所发生的事件程序

'应用程序事件代码位置：thisworkbook或者类模块

'应用程序事件代码在thisworkbook中的存在的先决条件

' 1.申明变量

' Public WithEvents app As ation

' 2.工作簿打开时运行

' Private Sub Workbook_Open()

' Set app = ation

' End Sub

' 3.将1、2点的代码写在thisworkbook中,并保存为“加载宏”文件（xla,xlam）

' 4.在加载宏菜单中加载第三步保存的加载宏文件。

' 目的：任何时候都能依附在excel文件中。

' 例子：任何时候都不能增加工作表

9：应用程序事件实例

整理版

.

Private Sub excelapp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) '4-8课内容

Bar = "选择区域是：" & s(0, 0) '任意工作表显示选择区域地址

End Sub

Private Sub excelapp_NewWorkbook(ByVal Wb As Workbook)

s(5).Show '强制新建就保存

End Sub

Private Sub excelapp_WorkbookBeforePrint(ByVal Wb As Workbook, Cancel As Boolean) '4-8课内容

a = InputBox("请输入打印密码") '打印机要求输入打印密码

If a = 123 Then

Cancel = False

Else

Cancel = True

MsgBox "对不起，密码不正确，你不能打印！"

End If

End Sub

10：事件总结

1.各种事件的作用范围

工作表：作用于某个工作表下的所有单元格操作

工作簿：作用于某个工作簿下的所有工作表

应用程序:作用于所有工作簿。

2.各种事件过程代码的执行顺序

工作表事件→工作薄事件→应用程序事件

整理版

.

第五章：VBA数组

1：数组基础

' 1.数组概念

' 数组就是一个列表或者一组数据表.

'

' 2.数组位置

' 数组存储在内存中.

'

' 3.数组特点

' a.读写速度快（从内存读取数据要比从硬盘读取快）

' b.无法永远保存(内存只是暂存空间)

' 4.数组分类

' a.一般分为：常量数组，静态数组，动态数组

' b.如按维度为：1维，2维，3维......60 维

'

' 5.当我们学会了数组，会发现以前的写的很多代码可以从数组的角度重写

'

Sub test2()

Dim arr1(3)

Dim arr2(1 To 3)

Dim arr3(1 To 3, 1 To 2)

Dim arr4(3, 2)

End Sub

2：数组维度

' 数组最多有60维，但在excel中一般最到2维

' 中的一行或一列可以转换1维数组

' 中的多行多列可以转换成2维数组

'

Sub test1()

arr1 = [{"A","B","C","D"}]

arr2 = ose([{1;2;3;4}]) 【转置】

End Sub

Sub test2()

arr3 = [{"张",1;"王",2;"陈",3;"李",4;"林",5}]

End Sub

Sub test4()

整理版

.

arr = Array(1, 2, 3, 4)

arr1 = Array(Array("a", "b"), Array(1, 2, 3))

End Sub

3向数组中写数据

Sub 循环向数组中写入数据()

Dim arr(1 To 4)

For Each Rng In [a1:a4]

n = n + 1

arr(n) = Rng

Next

End Sub

Sub 常量数组数据写入一般数组()

Dim arr()

arr = Array("V", "B", "A", 9)

End Sub

Sub 单元格区域数据批量写入数组()

arr = ose([a1:a4]) '注意：当向数组中批量写入多行，结果就是二维数组

arr1 = ose(ose([a7:d7]))

End Sub

4:在数组中取数据

'怎样在数组中取数

Sub 取数组中指定位置的元素()

arr = [a2:a5]

MsgBox arr(2, 1)

MsgBox arr(4, 1)

End Sub

Sub 方法1循环取数()

arr = [a2:a9]

[b1] = arr(2, 1)

For i = 1 To 8

Cells(i, 3) = arr(i, 1)

Next

End Sub

Sub 方法2一次性取数()

arr = [a2:a5]

Range("d1:d" & 4) = arr

End Sub

Sub 用transpose函数转置()

arr = [a2:a5]

整理版

.

arr1 = ose(arr)

[a7:d7] = arr1

[a8:c8] = arr1

[a9:e9] = arr1

'注意左右两边尺寸的对应 【赋值时候是从左向右】

End Sub

5：数组运用（数据汇总）

'在数组中求和，平均，最大，最小，极大，极小值等

Sub test()

arr = [b2:c9]

'MsgBox (arr)

'MsgBox e(arr)

'MsgBox (arr)

'MsgBox (arr)

'MsgBox (arr, 2)

MsgBox (arr, 2)

End Sub

Sub test2()

Dim arr1(1 To 99)

arr = [b2:c9]

For Each a In arr

If a >= 80 Then

n = n + 1

arr1(n) = a

End If

Next

MsgBox e(arr1)

End Sub

6：数组写入与读取实例(数组的优势体现)

'比比哪个程序的运行速度更快

Sub 方法一()

t = Timer

Set Rng = Cells(, 1).End(xlUp)

arr = Range([a1], Rng)

For Each a In Range([a1], Rng)

If a >= 90 Then n = n + 1: Cells(n, 3) = a

Next

MsgBox Format(Timer - t, "0.0000")

End Sub

整理版

.

Sub 方法二()

t = Timer

Dim arr1(1 To 5000, 1 To 1)

Set Rng = Cells(, 1).End(xlUp)

arr = Range([a1], Rng) '数组写入

For Each a In arr

If a >= 90 Then

n = n + 1

arr1(n, 1) = a '将arr数组中的数据有条件的将数据写入arr1数组

End If

Next

[d1].Resize(n) = arr1

MsgBox Format(Timer - t, "0.0000")

End Sub

7：数组应用之计算不重复值

'UBound 函数

'UBound(arrayname[, dimension])

'返回一个 Long 型数据，其值为指定的数组维可用的最大下标。

Sub test()

Dim arr(4 To 8, 1 To 3, 1 To 9)

MsgBox UBound(arr) '可简写为：UBound(arr）

MsgBox UBound(arr, 2)

MsgBox UBound(arr, 3)

MsgBox LBound(arr) 'LBound 用来确定数组某一维的上界。

End Sub

Sub 利用数组提取不重复值()

Dim arr1(1 To 10)

Set lastcell = Cells(, "b").End(xlUp) '查找最后B列最后一个非空单元格

arr = Range([b2], lastcell) '将B列的姓名数据赋值给变量arr形成一个数组

For i = 1 To - 1 '循环B列单元格个数的次数

For j = 1 To UBound(arr1) '找到arr1数组的最大小标，形成循环

x = arr(i, 1): y = arr1(j) '辅助代码

If arr(i, 1) = arr1(j) Then

GoTo 100 'arr数组元素与arr1元素循环对比，如果相等，则跳出内层循环

End If

Next j

k = k + 1 '做个计数器，计算相等重复的元素人数

arr1(k) = arr(i, 1) '如果循环完后都没有相等的，则将arr1循环的元素赋值给arr1数组

100:

Next i

整理版

.

[e2].Resize(k) = ose(arr1) '循环结束后将arr1的结果赋值给单元格区域

End Sub

8：数组运用(分类求和)

Sub 利用数组提取不重复值()

Dim arr1(1 To 10, 1 To 2)

Set endr = Cells(, "c").End(xlUp) '查找最后B列最后一个非空单元格

arr = Range([b2], endr) '将B列的姓名数据赋值给变量arr形成一个数组

For i = 1 To - 1 '循环B列单元格个数的次数

For j = 1 To UBound(arr1) '找到arr1数组的最大小标，形成循环

x = arr(i, 1): y = arr1(j, 1) '辅助代码

If arr(i, 1) = arr1(j, 1) Then

arr1(j, 2) = arr(i, 2) + arr1(j, 2)

GoTo 100 'arr数组元素与arr1元素循环对比，如果相等，则跳出内层循环

End If

Next j

k = k + 1 '做个计数器，计算相等重复的元素人数

arr1(k, 1) = arr(i, 1) '如果循环完后都没有相等的，则将arr1循环的元素赋值给arr1数组

arr1(k, 2) = arr(i, 2)

100:

Next i

[e2].Resize(k, 2) = arr1 '循环结束后将arr1的结果赋值给单元格区域

End Sub

9：动态数组（条件筛选）

'dim

'ReDim 语句

'在过程级别中使用，用于为动态数组变量重新分配存储空间。

'ReDim [Preserve] varname( ) [As type]

'可以使用 ReDim 语句反复地改变数组的元素以及维数的数目，

'有redim之后可以确定数组的上界，而不用估计一个值

Sub test3()

Dim arr(), arr1()

rn = Cells(, 1).End(xlUp).Address 【定位最后一行】

arr1 = Range("a2", rn)

m = f(Range("a2", rn), ">=80") '确定重新定义数组的上界【工作表函数】

ReDim arr(1 To m)

For Each ar In arr1

If ar >= 80 Then

n = n + 1

arr(n) = ar

End If

Next

整理版