excel vba 数据分析

(Visual Basic Application)

VBA(Visual Basic for Application)是Microsoft Office系列软件的内置编程语言，其语法结构与Visual Basic编程语言互相兼容，采用的是面向对象的编程机制和可视化的编程环境。

第一节标识符

一．定义

标识符是一种标识变量、常量、过程、函数、类等语言构成单位的符号，利用它可以完成对变量、常量、过程、函数、类等的引用。

二．命名规则

1）字母打头，由字母、数字和下划线组成，如 A987b_23Abc

2）字符长度小于40

3）不能与VB保留字重名，如public, private, dim, goto, next, with, integer, single等

第二节运算符

定义：运算符是代表VB某种运算功能的符号。

1）赋值运算符 =

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

3）逻辑运算符Not（非）、And（与）、Or（或）、Xor（异或）、Eqv（相等）、Imp（隐含）

4）关系运算符 = （相同）、<>（不等）、>（大于）、<（小于）、>=（不小于）、<=（不大于）、Like、Is

5）位运算符（暂时可不看位运算） Not（逻辑非）、And（逻辑与）、Or（逻辑或）、Xor（逻辑异或）、Eqv（逻辑等）、Imp（隐含）

第三节数据类型

VBA共有12种数据类型，具体见下表，此外用户还可以根据以下类型用Type自定义数据类型。

数据类型	类型标识符	字节
字符串型 String	$	字符长度(0-65400)
字节型 Byte	无	1
布尔型 Boolean	无	2
整数型 Integer	%	2
长整数型 Long	&	4
单精度型 Single	!	4
双精度型 Double	#	8
日期型 Date	无	8 公元100/1/1-9999/12/31
货币型 Currency	@	8
小数点型 Decimal	无	14
变体型 Variant	无	以上任意类型，可变
对象型 Object	无	4

第四节变量与常量

1）VBA允许使用未定义的变量，默认是变体变量。

2）在模块通用说明部份，加入 Option Explicit 语句可以强迫用户进行变量定义。

3）变量定义语句及变量作用域

Dim 变量 as 类型 '定义为局部变量，如 Dim xyz as integer

Private 变量 as 类型 '定义为私有变量，如 Private xyz as byte

Public 变量 as 类型 '定义为公有变量，如 Public xyz as single

Global 变量 as 类型 '定义为全局变量，如 Globlal xyz as date

Static 变量 as 类型 '定义为静态变量，如 Static xyz as double

一般变量作用域的原则是，那部份定义就在那部份起作用，模块中定义则在该模块那作用。

4）常量为变量的一种特例，用Const定义，且定义时赋值，程序中不能改变值，作用域也如同变量作用域。如下定义：Const Pi=3.1415926 as single

第五节数组

数组是包含相同数据类型的一组变量的集合，对数组中的单个变量引用通过数组索引下标进行。在内存中表现为一个连续的内存块，必须用Global或Dim语句来定义。定义规则如下：

Dim 数组名([lower to ]upper [, [lower to ]upper, ….]) as type ;Lower缺省值为0。二维数组是按行列排列，

如Dim X(9) as String 声明了一个10个元素的数组，X(0)~X(9),如果没有指定lower,则默认lower=0。

再例如Dim MyArray(10, 10) As Integer,是个11*11整数数组

除了以上固定数组外，VBA还有一种功能强大的动态数组，定义时无大小维数声明；在程序中再利用Redim语句来重新改变数组大小，原来数组内容可以通过加preserve关键字来保留。如下例：

Dim array1() as double : Redim array1(5) : array1(3)=250 : Redim preserve array1(5,10)

第六节注释和赋值语句

1）注释语句是用来说明程序中某些语句的功能和作用，注释语句不会被执行；VBA中有两种方法标识为注释语句。

ü 单引号 ’ ;如：’定义全局变量；可以位于别的语句之尾，也可单独一行

ü Rem ;如：Rem定义全局变量；只能单独一行

2）赋值语句是进行对变量或对象属性赋值的语句，采用赋值号 =，如X=123：Form1.caption=”我的窗口”

对对象的赋值采用：set myobject=object 或 myobject:=object

第七节书写规范

1）VBA不区分标识符的字母大小写，一律认为是小写字母；

2）最好以行只写一条语句。一行可以书写多条语句，各语句之间以冒号 : 分开；

3）一条语句可以多行书写，以空格加下划线 _ 来标识下行为续行；

4）标识符最好能简洁明了，不造成歧义。

第八节判断语句

1）If…Then…Else语句

If condition Then [statements][Else elsestatements]

condition 是个判断条件，当condition为真True，就执行Then后面的statements那些语句，如果为假False,执行elsestatements语句

如1：If A>B And C<D Then A=B+2 Else A=C+2

如2：If x>250 Then x=x-100

或者，可以使用块形式的语法，即If…Then…Else语句可以嵌套：

If condition Then

[statements]

[ElseIf condition-n Then

[elseifstatements] ...

[Else

[elsestatements]]

End If

如1:

If Number < 10 Then

Digits = 1

ElseIf Number < 100 Then

Digits = 2

Else

Digits = 3

End If

2）Select Case…Case…End Case语句

如1：Pid的取值来决定执行不同的语句

Select Case Pid

Case “A101”

Price=200 ‘当Pid的实际值是“A101”，就执行Price=200.后面的以此类推

Case “A102”

Price=300

……

Case Else

Price=900

End Case

第九节循环语句

1）For Next语句以指定次数来重复执行一组语句

For counter = start To end [Step step] ' step 缺省值为1

[statements]

[Exit For]

[statements]

Next [counter]

如1：for语句也可以嵌套，如下，两重for循环

For Words = 10 To 1 Step -1 ' 建立 10 次循环

For Chars = 0 To 9 ' 建立 10 次循环

MyString = MyString & Chars ' 将数字添加到字符串中

Next Chars ' Increment counter

MyString = MyString & " " ' 添加一个空格

Next Words

2）For Each…Next语句主要功能是对一个数组或集合对象进行，让所有元素重复执行一次语句

其作用就是遍历一遍数组或集合对象中的所有元素

For Each element In group ‘group 必要参数。对象集合或数组的名称（用户定义类型的数组除外）。

Statements

[Exit for]

Statements

Next [element]

如1：

For Each rang2 In range1

With range2.interior

.colorindex=6

.pattern=xlSolid

End with

这上面一例中用到了 With…End With 语句，目的是省去对象多次调用，加快速度；语法为：

With object

[statements]

End With

3）Do…loop语句 在条件为true时，重复执行区块命令

Do {while |until} condition ' while 为当型循环，until为直到型循环，顾名思义，不多说啦

Statements

Exit do

Statements

Loop

或者使用下面语法

Do ' 先do 再判断，即不论如何先干一次再说

Statements

Exit do

Statements

Loop {while |until} condition

4）while…wend语句，只要条件为TRUE，循环就执行如下例：

while condition ‘while I<50

[statements] ‘I=I+1

wend

第十节其他类语句和错误语句处理

这节可以省略，感兴趣的话可以看看

一．其他循环语句

结构化程序使用以上判断和循环语句已经足够，建议不要轻易使用下面的语句，虽然VBA还支持。

1) Goto line 该语句为跳转到line语句行

2) On expression gosub destinatioinlist 或者 on expression goto destinationlist 语句为根据 exprssion表达式值来跳转到所要的行号或行标记

3) Gosub line…line…Return语句， Return 返回到 Gosub line行，如下例：

Sub gosubtry()

Dim num

Num=inputbox(“输入一个数字，此值将会被判断循环”)

If num>0 then Gosub Routine1 ：Debug.print num：Exit sub

Routine1:

Num=num/5

Return

End sub

‘Wend

二．错误语句处理

执行阶段有时会有错误的情况发生，利用On Error语句来处理错误，启动一个错误的处理程序。语法如下：

On Error Goto Line　　　　　　　　　　　　‘当错误发生时，会立刻转移到line行去

On Error Resume Next ‘当错误发生时，会立刻转移到发生错误的下一行去

On Erro Goto 0 ‘当错误发生时，会立刻停止过程中任何错误处理过程

第十一节过程和函数

过程是构成程序的一个模块，往往用来完成一个相对独立的功能。过程可以使程序更清晰、更具结构性。VBA具有四种过程：Sub 过程、Function函数、Property属性过程和Event事件过程。

一．Sub过程

Sub 过程的参数有两种传递方式：按值传递(ByVal)和按地址传递(ByRef)。如下例：

Sub password (ByVal x as integer, ByRef y as integer)

If y=100 then y=x+y else y=x-y

x=x+100

End sub

Sub call_password ()

Dim x1 as integer

Dim y1 as integer

x1=12

y1=100

Call password (x1,y1) ‘调用过程方式：1. Call 过程名(参数1, 参数2…) ; 2. 过程名参数1, 参数2…

debug.print x1,y1 ‘结果是12、112，y1按地址传递改变了值，而x1按值传递，未改变原值

End sub

二．Function函数

函数实际是实现一种映射，它通过一定的映射规则，完成运算并返回结果。参数传递也两种：按值传递(ByVal)和按地址传递(ByRef)。如下例：

Function password(ByVal x as integer, byref y as integer) as boolean

If y=100 then y=x+y else y=x-y

x=x+100

if y=150 then password=true else password=false

End Function

Sub call_password ()

Dim x1 as integer Dim y1 as integer

x1=12

y1=100

if password then ‘调用函数：1. 作为一个表达式放在=右端 ; 2. 作为参数使用

debug.print x1

end if

End sub

三．Property属性过程和Event事件过程

这是VB在对象功能上添加的两个过程，与对象特征密切相关，也是VBA比较重要组成，技术比较复杂，可以参考相关书籍。我们的试验不涉及这两部分

第十二节内部函数

在VBA程序语言中有许多内置函数，可以帮助程序代码设计和减少代码的编写工作。

这部分重要是供我们查阅，直接使用的。一般要注意某个函数的需要输入的参数是什么类型的，函数的返回值又是什么类型的

一．测试函数

IsNumeric(x) ‘是否为数字, 返回Boolean结果，True or False

IsDate(x) ‘是否是日期, 返回Boolean结果，True or False

IsEmpty（x） ‘是否为Empty, 返回Boolean结果，True or False

IsArray(x) ‘指出变量是否为一个数组。

IsError(expression) ‘指出表达式是否为一个错误值

IsNull(expression) ‘指出表达式是否不包含任何有效数据 (Null)。

IsObject(identifier) ‘指出标识符是否表示对象变量

二．数学函数

Sin(X)、Cos(X)、Tan(X)、Atan(x) 三角函数，单位为弧度

Log(x) 返回x的自然对数

Exp(x)返回 e^x

Abs(x) 返回绝对值

Int(number)、Fix(number) 都返回参数的整数部分，区别：Int 将 -8.4 转换成 -9，而 Fix 将-8.4 转换成 -8

Sgn(number) 返回一个 Variant (Integer)，指出参数的正负号

Sqr(number) 返回一个 Double，指定参数的平方根

VarType(varname) 返回一个 Integer，指出变量的子类型

Rnd（x）返回0-1之间的单精度数据，x为随机种子

三．字符串函数

Trim(string) 去掉string左右两端空白

Ltrim(string) 去掉string左端空白

Rtrim(string) 去掉string右端空白

Len(string) 计算string长度

Left(string, x) 取string左段x个字符组成的字符串

Right(string, x) 取string右段x个字符组成的字符串

Mid(string, start,x) 取string从start位开始的x个字符组成的字符串

Ucase(string) 转换为大写

Lcase(string) 转换为小写

Space(x) 返回x个空白的字符串

Asc(string) 返回一个 integer，代表字符串中首字母的字符代码

Chr(charcode) 返回 string，其中包含有与指定的字符代码相关的字符

四．转换函数

CBool(expression) 转换为Boolean型

CByte(expression) 转换为Byte型

CCur(expression) 转换为Currency型

CDate(expression) 转换为Date型

CDbl(expression) 转换为Double型

CDec(expression) 转换为Decemal型

CInt(expression) 转换为Integer型

CLng(expression) 转换为Long型

CSng(expression) 转换为Single型

CStr(expression) 转换为String型

CVar(expression) 转换为Variant型

Val(string) 转换为数据型

Str(number) 转换为String

五．时间函数

Now 返回一个 Variant (Date)，根据计算机系统设置的日期和时间来指定日期和时间。

Date 返回包含系统日期的 Variant (Date)。

Time 返回一个指明当前系统时间的 Variant (Date)。

Timer 返回一个 Single，代表从午夜开始到现在经过的秒数。

TimeSerial(hour, minute, second) 返回一个 Variant (Date)，包含具有具体时、分、秒的时间。

DateDiff(interval, date1, date2[, firstdayofweek[, firstweekofyear]]) 返回 Variant (Long) 的值，表示两个指定日期间的时间间隔数目

Second(time) 返回一个 Variant (Integer)，其值为 0 到 59 之间的整数，表示一分钟之中的某个秒

Minute(time) 返回一个 Variant (Integer)，其值为 0 到 59 之间的整数，表示一小时中的某分钟

Hour(time) 返回一个 Variant (Integer)，其值为 0 到 23 之间的整数，表示一天之中的某一钟点

Day(date) 返回一个 Variant (Integer)，其值为 1 到 31 之间的整数，表示一个月中的某一日

Month(date) 返回一个 Variant (Integer)，其值为 1 到 12 之间的整数，表示一年中的某月

Year(date) 返回 Variant (Integer)，包含表示年份的整数。

Weekday(date, [firstdayofweek]) 返回一个 Variant (Integer)，包含一个整数，代表某个日期是星期几

第二章扩展运用

第一节全面控制 Excel

一、首先创建 Excel 对象，使用ComObj:
Dim ExcelID as Excel.Application
Set ExcelID as new Excel.Application
1) 显示当前窗口：
ExcelID.Visible := True;
2) 更改 Excel 标题栏：
ExcelID.Caption := \'应用程序调用 Microsoft Excel\';
3) 添加新工作簿：
ExcelID.WorkBooks.Add;
4) 打开已存在的工作簿：
ExcelID.WorkBooks.Open( \'C:\\Excel\\Demo.xls\' );
5) 设置第2个工作表为活动工作表：
ExcelID.WorkSheets[2].Activate;
或 ExcelID.WorkSheets[ \'Sheet2\' ].Activate;
6) 给单元格赋值：
ExcelID.Cells[1,4].Value := \'第一行第四列\';
7) 设置指定列的宽度（单位：字符个数），以第一列为例：
ExcelID.ActiveSheet.Columns[1].ColumnsWidth := 5;
8) 设置指定行的高度（单位：磅）（1磅＝0.035厘米），以第二行为例：
ExcelID.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1厘米
9) 在第8行之前插入分页符：
ExcelID.WorkSheets[1].Rows[8].PageBreak := 1;
参考代码：ActiveSheet.HPageBreaks(1).Location = Range("A22")
10) 在第8列之前删除分页符：
ExcelID.ActiveSheet.Columns[4].PageBreak := 0;
11) 指定边框线宽度：
ExcelID.ActiveSheet.Range[ \'B3:D4\' ].Borders[2].Weight := 3;
1-左 2-右 3-顶 4-底 5-斜( \\ ) 6-斜( / )
12) 清除第一行第四列单元格公式：
ExcelID.ActiveSheet.Cells[1,4].ClearContents;
13) 设置第一行字体属性：
ExcelID.ActiveSheet.Rows[1].Font.Name := \'隶书\';
ExcelID.ActiveSheet.Rows[1].Font.Color := clBlue;
ExcelID.ActiveSheet.Rows[1].Font.Bold := True;
ExcelID.ActiveSheet.Rows[1].Font.UnderLine := True;
14) 进行页面设置：
a.页眉：
ExcelID.ActiveSheet.PageSetup.CenterHeader := \'报表演示\';
b.页脚：
ExcelID.ActiveSheet.PageSetup.CenterFooter := \'第&P页\';
c.页眉到顶端边距2cm：
ExcelID.ActiveSheet.PageSetup.HeaderMargin := 2/0.035;
d.页脚到底端边距3cm：
ExcelID.ActiveSheet.PageSetup.HeaderMargin := 3/0.035;
e.顶边距2cm：
ExcelID.ActiveSheet.PageSetup.TopMargin := 2/0.035;
f.底边距2cm：
ExcelID.ActiveSheet.PageSetup.BottomMargin := 2/0.035;
g.左边距2cm：
ExcelID.ActiveSheet.PageSetup.LeftMargin := 2/0.035;
h.右边距2cm：
ExcelID.ActiveSheet.PageSetup.RightMargin := 2/0.035;
i.页面水平居中：
ExcelID.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035;
j.页面垂直居中：
ExcelID.ActiveSheet.PageSetup.CenterVertically := 2/0.035;
k.打印单元格网线：
ExcelID.ActiveSheet.PageSetup.PrintGridLines := True;
15) 拷贝操作：
a.拷贝整个工作表：
ExcelID.ActiveSheet.Used.Range.Copy;
b.拷贝指定区域：
ExcelID.ActiveSheet.Range[ \'A1:E2\' ].Copy;
c.从A1位置开始粘贴：
ExcelID.ActiveSheet.Range.[ \'A1\' ].PasteSpecial;
d.从文件尾部开始粘贴：
ExcelID.ActiveSheet.Range.PasteSpecial;
16) 插入一行或一列：
a. ExcelID.ActiveSheet.Rows[2].Insert;
b. ExcelID.ActiveSheet.Columns[1].Insert;
17) 删除一行或一列：
a. ExcelID.ActiveSheet.Rows[2].Delete;
b. ExcelID.ActiveSheet.Columns[1].Delete;
18) 打印预览工作表：
ExcelID.ActiveSheet.PrintPreview;
19) 打印输出工作表：
ExcelID.ActiveSheet.PrintOut;
20) 工作表保存：
If not ExcelID.ActiveWorkBook.Saved then
ExcelID.ActiveSheet.PrintPreview
End if
21) 工作表另存为：
ExcelID.SaveAs( \'C:\\Excel\\Demo1.xls\' );
22) 放弃存盘：
ExcelID.ActiveWorkBook.Saved := True;
23) 关闭工作簿：
ExcelID.WorkBooks.Close;
24) 退出 Excel：
ExcelID.Quit;
25) 设置工作表密码:
ExcelID.ActiveSheet.Protect "123", DrawingObjects:=True, Contents:=True, Scenarios:=True
26) EXCEL的显示方式为最大化
ExcelID.Application.WindowState = xlMaximized
27) 工作薄显示方式为最大化
ExcelID.ActiveWindow.WindowState = xlMaximized
28) 设置打开默认工作薄数量
ExcelID.SheetsInNewWorkbook = 3
29) \'关闭时是否提示保存(true 保存；false 不保存)
ExcelID.DisplayAlerts = False
30) 设置拆分窗口,及固定行位置
ExcelID.ActiveWindow.SplitRow = 1
ExcelID.ActiveWindow.FreezePanes = True
31) 设置打印时固定打印内容
ExcelID.ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
32) 设置打印标题
ExcelID.ActiveSheet.PageSetup.PrintTitleColumns = ""
33) 设置显示方式(分页方式显示)
ExcelID.ActiveWindow.View = xlPageBreakPreview
34) 设置显示比例
ExcelID.ActiveWindow.Zoom = 100
35) 让Excel 响应 DDE 请求
Ex.Application.IgnoreRemoteRequests = False
用VB操作EXCEL
Private Sub Command3_Click()
On Error GoTo err1
Dim i As Long
Dim j As Long
Dim objExl As Excel.Application \'声明对象变量
Me.MousePointer = 11 \'改变鼠标样式
Set objExl = New Excel.Application \'初始化对象变量
objExl.SheetsInNewWorkbook = 1 \'将新建的工作薄数量设为1
objExl.Workbooks.Add \'增加一个工作薄
objExl.Sheets(objExl.Sheets.Count).Name = "book1" \'修改工作薄名称
objExl.Sheets.Add , objExl.Sheets("book1") ‘增加第二个工作薄在第一个之后
objExl.Sheets(objExl.Sheets.Count).Name = "book2"
objExl.Sheets.Add , objExl.Sheets("book2") ‘增加第三个工作薄在第二个之后
objExl.Sheets(objExl.Sheets.Count).Name = "book3"
objExl.Sheets("book1").Select \'选中工作薄<book1>
For i = 1 To 50 \'循环写入数据
For j = 1 To 5
If i = 1 Then
objExl.Selection.NumberFormatLocal = "@" \'设置格式为文本
objExl.Cells(i, j) = " E " & i & j
Else
objExl.Cells(i, j) = i & j
End If
Next
Next
objExl.Rows("1:1").Select \'选中第一行
objExl.Selection.Font.Bold = True \'设为粗体
objExl.Selection.Font.Size = 24 \'设置字体大小
objExl.Cells.EntireColumn.AutoFit \'自动调整列宽
objExl.ActiveWindow.SplitRow = 1 \'拆分第一行
objExl.ActiveWindow. SplitColumn = 0 \'拆分列
objExl.ActiveWindow.FreezePanes = True \'固定拆分 objExl.ActiveSheet.PageSetup.PrintTitleRows = "$1:$1" \'设置打印固定行
objExl.ActiveSheet.PageSetup.PrintTitleColumns = "" \'打印标题 objExl.ActiveSheet.PageSetup.RightFooter = "打印时间: " & _
Format(Now, "yyyy年mm月dd日 hh:MM:ss")
objExl.ActiveWindow.View = xlPageBreakPreview \'设置显示方式
objExl.ActiveWindow.Zoom = 100 \'设置显示大小
objExl.ActiveSheet.PageSetup.Orientation = xlLandscape ‘设置打印方向(横向)
\'给工作表加密码
objExl.ActiveSheet.Protect "123", DrawingObjects:=True, _
Contents:=True, Scenarios:=True
objExl.Application.IgnoreRemoteRequests = False
objExl.Visible = True \'使EXCEL可见
objExl.Application.WindowState = xlMaximized \'EXCEL的显示方式为最大化
objExl.ActiveWindow.WindowState = xlMaximized \'工作薄显示方式为最大化
objExl.SheetsInNewWorkbook = 3 \'将默认新工作薄数量改回3个
Set objExl = Nothing \'清除对象
Me.MousePointer = 0 \'修改鼠标
Exit Sub
err1:
objExl.SheetsInNewWorkbook = 3
objExl.DisplayAlerts = False \'关闭时不提示保存
objExl.Quit \'关闭EXCEL
objExl.DisplayAlerts = True \'关闭时提示保存
Set objExl = Nothing
Me.MousePointer = 0
End Sub

第二节 Inputbox函数的功能与作用

Inputbox函数是VBA中用于数据输入的函数，它可以在一个对话框中显示提示并等待用户输入信息或，在按下按钮后返回用户输入的String类型字符串。
Inputbox通常用于为用户提供录入窗口，然后将返窗口中的录入字符串按代码指定方式导入到相应的窗口或者根据输入值来决定后续的操作。
例如图2.1中，用户的录入信息决定程序的后续执行方式。

图2.1 以录入值确定计算方式
当然，Inputbox也有其它的很多作用，例如输入一个数值来参与运算，如图2.2所示。

图2.2 对录入值进行运算
(1)Inputbox函数的语法
Inputbox的具体语法如下：
InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context])
其中第一参数是必选参数，其余参数为可选参数。各参数的详细解释如下：
表2.1
Inputbox的参数详解

部分	描述
Prompt	作为对话框消息出现的字符串表达式。prompt 的最大长度大约是 1024 个字符，由所用字符的宽度决定。
Title	显示对话框标题栏中的字符串表达式。如果省略 title，则把应用程序名放入标题栏中
Default	显示文本框中的字符串表达式，在没有其它输入时作为缺省值
Xpos	数值表达式，成对出现，指定对话框的左边与屏幕左边的水平距离。如果省略 xpos，则对话框会在水平方向居中
Ypos	数值表达式，成对出现，指定对话框的上边与屏幕上边的距离。如果省略 ypos，则对话框被放置在屏幕垂直方向距下边大约三分之一的位置
Helpfile	字符串表达式，识别帮助文件，用该文件为对话框提供上下文相关的帮助
Context	数值表达式，由帮助文件的作者指定给某个帮助主题的帮助上下文编号

其中最重要的参数是前面三个，包括提示信息、标题和默认值。在特殊情况下，第四、五参数也具有其实用价值——强制指定对话框的显示位置，从而防止对话框挡住当前窗口。
或许从以下案例中，可以加深对Inputbox函数的认识。
(2).定制“另存为”对话框
设计一个用于文件另存的对话框，固定保存在C盘下，用户可以随意定制文件名，默认名称为当前日期。代码如下：
___________________________________________________________________

Sub 工作簿另存()
Dim FileName As String'声明变量
'弹出一个录入框，让用户指定文件名，默认值为当前日期
FileName = InputBox("请输入工作簿新名称", "另存为", Date)'当前工作簿另存到C盘中，文件名为用户指定字符
ThisWorkbook.SaveAs "c:\" & FileName
End Sub
___________________________________________________________________

执行以上代码时，将弹出一个“另存为”对话框供用户录入新名称，其默认值为当前日期，见图2.3所示：

图2.3 定制的“另存为”对话框
(3)根据指定月份批量创建工作表
用户指定的月份，程序批量创建该月每日日期命名的工作表。代码如下：

___________________________________________________________________

Sub 新建工作表()'批量建立新表，个数等于本月天数，同时对日期命名，并建立目录
Dim i As Byte, months As Byte'声明变量
'弹出一个对话框，让用户指定月份,默认显示当前月
months = InputBox("请输入月份，程序将建立该月每日日期命名的工作表", "确定月份", Month(Date))
'批量生成工作表，其个数等于指定月份的天数减去当前已有工作表个数，即确保工作表数量等于该月天数
Sheets.Add After:=Sheets(Sheets.Count), Count:=Day(DateSerial(Year(Date), months + 1, 0)) - Sheets.Count'将所有工作表重命名，工作表名对应每日的日期
For i = 1 To Sheets.Count
Sheets(i).Name = months & "月" & i & "日"'对每个工作表命名
Next i
MsgBox "建立完毕！", 64
End Sub

___________________________________________________________________

在以上代码中，Inputbox可以弹出一个对话框，让用户指定月份，默认值为当前月份。而当前月份的计算方式是利用Month函数从当前日期Date中获取。
其中计算用户指定的月份有多少天时，鉴于VBA自动日期转换的特点——将0日当做上月最后一天处理，所以程序利用DateSerial函数将下月0日转换成本月最后一天的日期序列，最后再用Day函数提取其天数，表示当月有多少天。
图2.4是Inputbox函数设置的对话框，让用户指定月份；而图31.5是批量创建的工作表。

图2.4 指定月份的录入框

图2.5 批量创建工作表后的效果
如果在Inputbox中需要是更多的提示信息，那么可以使用Chr(10)来分行。例如本例中Inputbox语句可以修改为：
months = InputBox("请输入月份，程序将建立该月每日日期命名的工作表" & Chr(10) & "例如输入4月，则产生的工人表则为4月1日、4月2日.......", "确定月份", Month(Date))
(4).将A1日期按指定样式转换为星期
A1存放日期，现需将其转换星期，程序需要让用户决定转换方式，即提供三个可选项。
达成以上需求可以使用以下代码：

___________________________________________________________________

Sub 将A1日期转换为星期()
Dim Week As Byte'声明变量
'提供输入框，让用户选择转换方式。在输入框中可以预览转换后的结果
Week = InputBox("请选择转换样式：" & Chr(10) & "输入1：" & Format([a1], "DDD") & Chr(10) _
& "输入2：" & Format([a1], "DDDD") & Chr(10) & "输入3：" & Format([a1], "AAA"))'根据用户录入的数字对A1的日期进行转换
[b1] = Format([a1].Value, Choose(Week, "DDD", "DDDD", "AAA"))
End Sub
___________________________________________________________________

该过程中利用Inputbox显示一个输入框，在输入框中可以预览转换后的四种日期样式，只用输入1到3之间的任何数字，程序会对应地转换日期为该格式。假设A1的是“5月9日”，那么执行程序后输入框外观见图31.6所示。

图2.6 提示用户选择转换样式
在该过程中，使用了Choose函数，它可以根据第一参数的值从后面的参数中选择对应的值做为Format的参数。程序没有使用防错功能，如果输入的值小于1或者大于3将产生错误。

(5) 　Inputbox函数在工作中应用非常的广泛，本节通过一个实例演示Inputbox函数搭配其它代码实现生成指定月份的月历。月历中包括该月每一天及对应的星期。
　　　本实例除Inputbox的知识外，还涉及如下知识点：
　　　（1）数据类型转换
　　　（2）错误设置
　　　（3）日期的转化
　　　（4）区域合并
　　　（5）VBA录入数组公式
　　　（6）文本替换
　　　（7）为单元格设置边框
　　　（8）将公式转换成值
　　　具体操作步骤如下：
　　　1.打开ET　2009，使用快捷键〖Alt+F11〗进入VBE界面；
　　　2.单击菜单〖插入〗\〖模块〗；
　　　3.在模块中录入以下代码：
_______________________________________________________

Sub 生成月历()
On Error Resume Next'防错：有错误时继续下一步
Dim Months As Byte
'提供一个让用户指定月份的对话框，对话框显示屏幕左上角，其上边距和左边距均为10
'inputbox反回值是String型，利用CByte转换成Byte型Star:
Months = CByte(InputBox("请指定月份，程序将生成该月的月历", "月份", Month(Date), 10, 10))
If err <> 0 Then err.Clear: GoTo Star'如果有错误则返回重新输入
If Months < 1 Or Months > 12 Then MsgBox "只能在1-12之间，请重新输入。", 64, "提示": GoTo Star
Application.ScreenUpdating = False'关闭屏幕更新，加快速度
With ActiveCell'在当前单元格显示当前指定月份第一日的日期
.Value = Format(DateSerial(Year(Date), Months, 1), "yyyy年m月d日")'对首行7列合并居中
.Resize(1, 7).Merge
.HorizontalAlignment = etHAlignCenter' 设置标题行数据并设置为居中显示产，添加颜色
With .Offset(1, 0).Resize(1, 7)
.Value = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")'标题
.HorizontalAlignment = ksoCenter'居中显示
.Interior.ColorIndex = 15'标示背景色
.Font.Bold = True'加粗显示
End With
On Error GoTo err'当出错时执行Err标签处的语句
With .Offset(2, 0).Resize(6, 7)'设置公式区域
'建立数组公式
.FormulaArray = "=text(IF(MONTH(" & ActiveCell.MergeArea(1).Address(0, 0) & ")<>MONTH(" & ActiveCell.MergeArea(1).Address(0, 0) & "-(WEEKDAY(" & ActiveCell.MergeArea(1).Address(0, 0) & ")-1)+{0;1;2;3;4;5}*7+{0,1,2,3,4,5,6}),""""," & ActiveCell.MergeArea(1).Address(0, 0) & "-(WEEKDAY(" & ActiveCell.MergeArea(1).Address(0, 0) & ")-1)+{0;1;2;3;4;5}*7+{0,1,2,3,4,5,6}),""d"")"
.HorizontalAlignment = etHAlignCenter'居中对齐
.VerticalAlignment = etVAlignCenter
End With
With .Resize(8, 7)'将公式转换成值（ET中无对数组公式的转换比Excel麻烦一点）
.Copy
.PasteSpecial Paste:=xlPasteValues'将公式选择粘贴，从而转换成值
.Value = .Value'再去除绿色粘三角提示
.EntireColumn.AutoFit'自动调整列宽
'加边框
.Borders.Weight = etThin'中间用细线
.Borders(xlEdgeLeft).Weight = etThick'四周用粗线
.Borders(xlEdgeRight).Weight = etThick
.Borders(xlEdgeTop).Weight = etThick
.Borders(xlEdgeBottom).Weight = etThick
End With
End With
Application.ScreenUpdating = True
Exit Sub
err:
Application.ScreenUpdating = True
MsgBox "您输入的月份包括文本" & Chr(10) & "或者当前区域无法写入", 65
End Sub
_______________________________________________________

　　　录入代码后返回工作表，通过以下步骤测试代码的可行性：
　　　（1）选择单元格A1，然后按下快捷键【Alt+F8】打开“宏”对话框；
　　　（2）如果工作簿中仅有一个宏，那么ET会自动选定“生成月历”，否则手工选择宏名“生成月历”并单击“执行”按钮；
　　　（3）此时程序将弹出图2.7所示对话框，提示用户输入日期，其默认值当前月的月份；
　　　（4）输入字母“A”或者输入数字13，那么程序会弹出图2.8所示对话框。因为月份只能是1到12之间的数字；
　　　　
　　　　　　图2.7 提示录入月份
　　　
　　　　　　图2.8 错误提示
　　　（5）如果直接单击“确定“按钮，那么当前工作表中B1开始的7列8行将产生图2.9所示月历：
　　　
　　　　　　图2.9 月历
　　　在产生月历前，需要确保当前单元格开始右下方7列8行无数据，如果该区域非空，则月历会覆盖该区域中的数据；同时还要确保该区域中不存在合并单元格，因月历无法在合并单元格中录入数组公式。
　　　如果读者认为以上限制太多，也可以变通地实现，突破这两个限制。方法是在当前单元格右方插入新七个空白列。插入的代码如下：
　　　ActiveCell.Resize(1, 7).EntireColumn.Insert Shift:=xlToRight
　　　其中EntireColumn代表整列，如果仅仅对7个单元格进行插入，那么也只能插入7个单元格；对7列进行插入，则会相应地插入7列。

第三节 Msgbox

(1) Msgbox的参数
Msgbox的具体语法如下：
MsgBox(prompt[, buttons] [, title] [, helpfile, context])
其中Prompt参数是必选参数，其作参数是可选数。各参数功能详解如下表3-1所示：
表3-1　Msgbox参数详解

参数	描述
Prompt	字符串表达式，作为显示在对话框中的消息。prompt 的最大长度大约为 1024 个字符，由所用字符的宽度决定
Buttons	指定显示按钮的数目及形式、使用的图标样式、缺省按钮是什么以及消息框的强制回应等
Title	在对话框标题栏中显示的字符串表达式。如果省略 title，则将应用程序名放在标题栏中
Helpfile	字符串表达式，识别用来向对话框提供上下文相关帮助的帮助文件
Context	数值表达式，由帮助文件的作者指定给适当的帮助主题的帮助上下文编号

其中最重要的是前两个参数，第一个参数决定显示的信息，不超1024个字符的文本；第二个参数决定图标及按钮。
(2) Msgbox的按钮与图标
Msgbox的第二参数可以有多种组合，实现不同的按钮与图标样式。在表28-2罗列出了VBA中Msgbox提示的常数列表。
表3-2　Msgbox图标与按钮常数详解

常数	值	描述
vbOKOnly	0	只显示 OK 按钮
VbOKCancel	1	显示 OK 及 Cancel 按钮
VbAbortRetryIgnore	2	显示 Abort、Retry 及 Ignore 按钮
VbYesNoCancel	3	显示 Yes、No 及 Cancel 按钮
VbYesNo	4	显示 Yes 及 No 按钮
VbRetryCancel	5	显示 Retry 及 Cancel 按钮
VbCritical	16	显示 Critical Message 图标
VbQuestion	32	显示 Warning Query 图标
VbExclamation	48	显示 Warning Message 图标
VbInformation	64	显示 Information Message 图标
vbDefaultButton1	0	第一个按钮是缺省值
vbDefaultButton2	256	第二个按钮是缺省值
vbDefaultButton3	512	第三个按钮是缺省值
vbDefaultButton4	768	第四个按钮是缺省值
vbApplicationModal	0	应用程序强制返回；应用程序一直被挂起，直到用户对消息框作出响应才继续工作
vbSystemModal	4096	系统强制返回；全部应用程序都被挂起，直到用户对消息框作出响应才继续工作
vbMsgBoxHelpButton	16384	将Help按钮添加到消息框
VbMsgBoxSetForeground	65536	指定消息框窗口作为前景窗口
vbMsgBoxRight	524288	文本为右对齐
vbMsgBoxRtlReading	1048576	指定文本应为在希伯来和阿拉伯语系统中的从右到左显示

以上表3-2中，实际包括四组信息，其中第一组值 (0–5) 描述了对话框中显示的按钮的类型与数目；第二组值(16, 32, 48, 64) 描述了图标的样式；第三组值 (0, 256, 512) 说明哪一个按钮是默认值；而第四组值 (0, 4096) 则决定消息框的强制返回性。Msgbox的第二参数可以从四组中选择值相加来任意设置信息框的显示样式。
例如需要显示一个两行信息且带一个OK按钮的对话框，那么可以使用以下代码：
MsgBox "第一行" & Chr(10) & "第二行", vbOKOnly
执行后效果如图3.3所示。
如果需要显示一个确定按钮与一个取消按钮，且标题显示为“提示”，那么可用以下代码：
MsgBox "现在开始执行？", vbOKCancel, "提示"
执行后效果见图3.4所示：
　　　
图3.3　两行信息且带一个OK按钮

图3.4　一个确定按钮与一个取消按钮
如果同样是显示图3.4的效果，如果需要默认选中第二个，那么代码可以修改如下：
MsgBox "现在开始执行？", vbOKCancel + vbDefaultButton2, "提示"
Msgbox的第二参数使用了“vbOKCancel + vbDefaultButton2”，即表示默认值为第二个按钮，当用户直接单击回车键时是按下“取消”而非“确定”。效果图3.5.3所示：
如果在需要显示“是”和“否”按钮，再加入一个问号图标，且使用数字来表示按钮样式，那么代码如下：
MsgBox "继续执行下步？", 292, "继续"
代码中292的计算方式是：4 + 32 + 256，其中4表示显示“是”和“否”的按钮，32代表显示问号图标，而256则表示默认默认按钮为第二个。执行后效果见图3.6所示：

　　　

图3.5　一个确定按钮与一个取消按钮默认第二个

　　　　图3.6　两个按钮加问号图标
当然，根据表3-2所示的常数值还可以有很多种组合，读者可以自行测试。
(3) Msgbox的返回值
Msgbox主要作用是显示一些信息给终端用户，然而对于程序开发者来说，更重要的一个功能是它具有返回值，且可以根据返回值决定下一步操作。
Msgbox的返回值有7种，见表3-7所示：
表3-7　Msgbox的返回值

常数	值	描述
vbOK	1	OK
vbCancel	2	Cancel
vbAbort	3	Abort
vbRetry	4	Retry
vbIgnore	5	Ignore
vbYes	6	Yes
vbNo	7	No

Msgbox的返回值对于开发者来说比较有用。例如用户单击“是”按钮时，执行后续的操作，如果单击“否”则直接退出程序。那么可以参考以下代码：
______________________________________________
Sub 工作表改名()
'声明变量，用代获取Msgbox的返回值
Dim msg As VbMsgBoxResult
'获取Msgbox返回值
msg = MsgBox("将前表改名为今日期？", 292, "修改日期")'如果用户单击是
IF msg = vbYes Then'执行改名
ActiveSheet.Name = Date
Else'否则退出程
Exit Sub
End IF
'其它更多代码.............
End Sub
_________________________________________

执行以上代码时，将弹出图3.8所示对信息框，如果用户直接单击回键，那么程序立即退出，不做任何回应；如果用户单击“是”按钮，那么立即以当前日期命名工作表，见图3.9所示。

　
图3.8　询问执行方式

　　　　　　　　图3.9选择“是”按钮则工作表改名
在需用Msgbox函数返回值时，Msgbox的各参数必须使用括号，而不需要返回值时，这不是一个表达式，则不需要括号。以下两种方式都是错误的Msgbox用法：
MsgBox( "你好! ", 64, "提示")
Result = MsgBox　"你好! ", 64, "提示"

(4)Msgbox的限制
总体来说，Msgbox具有三方面的限制。
l字符数问题
Msgbox有最大高度与宽度限制，而且只有在字符超过它的限制时才可以它体现出来。因为Msgbox具有自动缩放功能，当信息少时它会自动缩小信息框以适应字符的宽度，此时无法目视它的可用范围。要测试Msgbox可显示的最多字符数可以使用以下方式：
（1）在[A1]单元格中存放超1000个英文字母，在[a2]单元格中存放超过1000个汉字；
（2）在模块中录入以下语句：
________________________________

Sub Msgbox测试()
MsgBox [a1]
MsgBox [a2]
End Sub
____________________________

执行以上代码后，可以发现，英文字符可以显示1024个左右，而纯汉字只能显示511个。如果英文与汉字共用，那么按一个汉字占用两个英文宽度计算。
如果需要显示超过以上限制的字符信息，那么只能分屏显示，当然这不是好办法。通常采用窗体控件或者WScript技术来突破。
l控制权问题
Msgbox对话框总是拥有焦点，且拥有绝对的控制权。即只要Msgbox对话框不关闭，那么其它代码都会停止运行，只有关闭对话框后才会交还控制权给程序，继续执行其它语句。
明白这一点很重要，如果程序在执行过程中需要显示信息，例如当前执行进行，而且不能影响程序地继续执行，那么Msgbox方式并非首选。建议使用状态栏信息或者无模体的窗体。
图3.10即为利用状态显示进度来替换Msgbox的效果。

图3.10 状态栏是示程序执行进度
l时间性问题
Msgbox的对话框显示的对话框，如果用户不手动关闭，它会永远存在。如果用户需要它在指定时间自动关闭，那么Msgbox也无法达成需求。
通常采用三种方法来实现：用户窗体、WScript技术和API，在后面将提进行演示。
(5)突破Msgbox限制
WScrip是一种脚本语言，它也可以实现输出对话框信息，而且可以突破Msgbox的一些限制。
利用脚本语言显示信息可用WScript.Shell语言中的Popup方法。它的具体语法为：
WshShell.Popup(strText, [natSecondsToWait], [strTitle], [natType]) = intButton
其中第一参数是显示的信息，第二参数是显示的时间，表示信息框在多少秒钟的自动关闭，第三参数是标题，第四参数是按钮与图标的状态。
WScript.Shell语言中的Popup方法相对于Msgbox有两个优点：
l可显示的字符远远超过1024
l可以自动关闭对话框（有某些软件冲突）
如果A1单元格的超过500个字符，那么可以使用以下语句显示A1字符串的文本框：
_________________________________________________

Sub 显示A1信息()
CreateObject("WScript.Shell").Popup [a1], , "提示", 64
End Sub
___________________________________________

以上代码对字符1个到1000个、甚至3000、10000个都可以正常执行，不再有Msgbox的限制。
如果需要信息显示3秒钟自动关闭，可以用以下代码：
__________________________________________________________
Sub 自动关闭()
CreateObject("WScript.Shell").Popup "三秒钟关闭", 3, "提示", 64
End Sub
___________________________________________________

但经过多次测试，以上语句的稳定性不是很好，有很多软件的冲突，例如在Excel 2003中工作良好，在Excel 2007中却无法自动关闭，在ET中也存在冲突。所以为了体现通用性和稳定性，可以改用API来完成这个难题，让ET和Excel都可以顺利实现3秒钟关闭。
API实现的方式如下：
__________________________________________________________
Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElaspe As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Dim TID As Long
Const Sec = 3'可以在这里修改时间
Sub CloseTest(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
Application.SendKeys "~", True '发送回符，即关闭窗口的命令
KillTimer 0, TID
End Sub
Sub 三秒钟自动关闭()
TID = SetTimer(0, 0, Sec * 1000, AddressOf CloseTest)
MsgBox Sec & "秒种自动关闭窗口", 65, "提示"
End Sub
___________________________________________________________

而利用窗体来实破Msgbox的所有限制则显得简单多了，在以后的章节会专门讲述窗体与窗体控件的应用。

第四节 Debug.Print

Debug.Print也可以实现信息输出，不过通常开发人员使用。它只能在VBE中的立即窗口显示信息，而终端用户是不需要进入VBE界面查看任何信息的。
Debug.Print表示在立即窗口中显示文本，其具体语法为：
Debug.Print [outputlist]
它的功能是将信息输出到立即窗口，通常是开发者调试代码时使用。其中参数outputlist 可选的。要打印的表达式或表达式的列表。如果省略，则打印一空白行。
outputlist 参数也具有它自己的语法：
{Spc(n) | Tab(n)} expression charpos
各参数含义见表30-1所示
30-1 outputlist 参数详解

参数	含义
Spc(n)	可选的。用来在输出中插入空白字符，这里，n 为要插入的空白字符数。
Tab(n)	可选的。用来将插入点定位在绝对列号上，这里，n 为列号。使用无参数的 Tab(n) 将插入点定位在下一个打印区的起始位置。
expression	可选。要打印的数值表达式或字符串表达式。
charpos	可选。指定下个字符的插入点。使用分号 (;) 直接将插入点定位在上一个被显示的字符之后。使用 Tab(n) 将插入点定位在绝对列号上。使用无参数的 Tab 将插入点定位在下一个打印区的起始位置。如果省略 charpos，则在下一行打印下一字符。

通过以下代码可以更好地理解其它参数含义：
___________________________________________

Sub test()
Debug.Print "A"
Debug.Print
Debug.Print Spc(10)
Debug.Print "B"
End Sub
____________________________________________

执行以上代码后，将在立即窗口产生四行字符，其中第二行是空行，第三行为10个空格。见图30.1所示：

图30.1 Debug.Print演示
再如，程序中要求打开当前工作簿路径下的“VBA教学.xls”文件，在打开文件前调试程序时，程序员需要查看一下路径是否存在或者查看路径所在磁盘名，那么可以通过“Debug.Print”方式将信息显示在窗口。代码如下：
___________________________________________
Sub 打开当前工作簿同路径下的文件()
Dim Paths As String'声明变量
Paths = ActiveWorkbook.Path'获取路径
Debug.Print Paths'查看路径
Workbooks.Open Filename:=Paths & "VBA教学.xls"'打开工作簿
End Sub
__________________________________________
执行以上代码后，在立即窗口中将产生路径，见图30.2所示。

图30.2 在立窗口显示信息

第五节条件语句

条件语句主要包括以下五种：
IIF
IF…Then…
IF…Then…End IF
Select Case…End Select
Choose
本节以及以后的章节中将陆续讲述以上五种条件语句的语法及应用。本节的重点是IIF函数的语法。
IIF函数是VBA中类似于工作表IF的条件函数，它基于条件返回不同的值。下面展示它的参数及用法。
(1)IIF的语法
IIF函数可以根据表达式的值，来返回两部分中的其中一个。它的基本语法为：
IIF(expr, truepart, falsepart)
IIF的三个参数均为必选参数，各参数的含义见表33-1所示：
表33-1　IIF的参数详解

部分	描述
expr	用来判断真伪的表达式
truepart	如果 expr 为 True，则返回本参数的值或表达式
falsepart	如果 expr 为 False，则返回本参数的值或表达式

如果需要表达大于等于60分时返回“及格”否则返回“不及格”，那么可用以下语句：
IIF([a1] >= 60, "及格", "不及格")
如果第二、三条件的字符较长，且不同的字符较少，为了缩短代码，也可以改用以下方式：
"A1的成绩" & IIF([a1] >= 60, "", "不") & "及格"
即把相同部分置于IIF语句之外，用IIF的第二、三参数来决定不同的部分。
再如A1大于B1时，则返回C1的值，否则返回C1值的50%，那么可用以下语句：
IIF([a1] > [b1], [c1], [c1] / 2)
也可以改用以下方式，将C1置于IIF语句之外，代码如下：
[C1] / IIF([a1] > [b1], 1, 2)

(2)根据录入的月份判断其季度
利用录入框让用户录入月份，默认为当前月，并根据月份判断其季度。代码如下：
____________________________________________________

Sub 根据月份判断季度()
Dim Months As Byte'声明变量
Star:'设置一个标签
'弹出对话框让用户录入月份，默认为当前月份
Months = InputBox("请输入月份，只能是数字", "月份", Month(Date) * 1)
'如果录入的数值小于1或者大于12则返回标签Star处继续执行
If Months < 1 Or Months > 12 Then MsgBox "只能在1到12之间": GoTo Star
'四个IIF嵌套运用，其中每个IIF的第一参数使用双条件，在双条件时需要用And连接
MsgBox IIf(Months > 1 And Months < 4, "一季度", IIf(Months > 3 And Months < 7, "二季度", IIf(Months > 6 _
And Months < 10, "三季度", IIf(Months > 9 And Months < 1, "四季度", "录入错误"))))
End Sub
____________________________________________________

本例中使用VBA中的IF语句配合Or运算符检查录入数值是否在1到12之间，如果不在该范围则提示，且返回“Satr”标签处，让用户重新输入数值，直到符合条件完止。
在过程中，使用了四个IIF函数嵌套，且四个IIF函数的第一个条件都包括两个参数，利用And进行连接。
在执行程序时，将弹出一个录入数字的对话框，其默认值为当前月份，见图34.1所示。如果此时录入0或者13将会提示“只能输入1到12间”，且再次返回月份录入对话框等待用户录入正确的数字。当输入数字9后，返回结果见图34.2所示。
　

图34.1　月份录入框　　　　　　　　　　　　　

图34.2　根据月份判断季度
(3)多条件计算奖金
某公司对业务员的奖金计算方式为：业绩高于12万，其利润比例在15%以上者奖金为2000元；业绩高于8万、利润12%以上但劳当选为劳模者也可以奖金2000元，其他人奖金1000元。
利用VBA对图10.29所示业务员计算奖金之代码如下：

____________________________________________________

Sub 计算奖金()
Dim i As Byte'从2开始至最后一行个非空行结束
For i = 2 To WorksheetFunction.CountA([B:B])'根据要求设置条件
Cells(i, "E") = IIF((Cells(i, "B") > 12 And Cells(i, "C") > 0.15) Or ((Cells(i, "B") > 8 _
And Cells(i, "C") > 0.12) And Cells(i, "D") = "是"), 2000, 1000)
Next i
End Sub

____________________________________________________

该过程中And运算符与Or运算符合用，显得较复杂，但可以顺利地完成需求。读者需要将代码与题目要求进行详细的对比，理解代码的设计思路。

图34.3　奖金计算表
(4)IIF函数的限制
IIF是一个函数，与工作表函数IF极其相似。但是在使用上，相对于IF函数却不够灵活，主要体现在以下方面。
l第三参数是否必选参数
IIF的第三参数是必须参数，而IF函数的第三参数是可选参数。
例如工作表中可以使用以下公式，仅仅声明满足条件时的反回值：
=IF(A1>=60,"及格")
但是使用IIF时必须使用第三参数，否则将产生编译错误。
l是否检验第三参数
当第一参数——条件为True时，IF函数可以忽略第三参数；而IIF函数则会同时样检验第三参数的值，如果第三参数存在错误值则程序会中断。例如以下语句：
IIF([a1] > [b1], [b1] / [a1], [a1] / [b1])

当单元格a1大于0且b1为0时，程序会产生编译错误。因为IIF的特点是条件成立仍然检测第三数；如果使用工作表函数IF，则不会产生任何错误。
l错误方式
当IF函数计算结果为错误值时，它会在单元格中产生对应的值，不影响其它单元格中的公式；而IIF的第三参数中假设使用了零做除数，那么整个过程都会中断，并提示错误信息。
虽然IF较IIF更好用，但是在VBA中不能调用工作表函数IF，只能调用IFError或者Iferr等等函数。

(5)And运算符与Or运算符
当IIF函数使用多条件时，必须借助And运算符与Or运算符来连接其条件。
如果需要同时满足多条件时，可使用And运算符。And运算符的主要作用是对两个表达式进行逻辑连接。表达式如下：
result = expression1 And expression2
其中result与expression1、expression2之间的关系见表33-2所示：
表33-2　And运算符参数与结果之关系

如果 expression1 为	且 expression2 为	则 result 为
TRUE	TRUE	TRUE
TRUE	FALSE	FALSE
TRUE	Null	Null
FALSE	TRUE	FALSE
FALSE	FALSE	FALSE
FALSE	Null	FALSE
Null	TRUE	Null
Null	FALSE	FALSE
Null	Null	Null

如果有三个条件可以采用以下表达式：
result = expression1 And expression2 And expression3
如果某行业招聘时要求体重在50到65公斤之间合格，否则不合格，那么VBA表达方式如下：
Msgbox IIF([a1] > 50 And [a1] < 65, "合格", "不合格")
如果需要多条件中满足条件之一即可返回指定值，那么可以使用Or运算符，其主要作用是对两个表达式进行逻辑析取运算。其表达式如下：
result = expression1 And expression2
其中result与expression1、expression2之间的关系见表33-3所示：
表33-3　 Or运算符参数与结果之关系

部分	描述
result	必需的；任何数值变量
expression1	必需的；任何表达式
expression2	必需的；任何表达式

如果成绩小于1或者大于100则提示“录入错误”，否则返回空值，那么VBA表达方式如下：
MsgBox IIF([a1] > 100 Or [a1] < 1, "录入错误", "")
IIF函数也可以嵌套使用，即一句代码中使用多个IIF，根据两个以上的条件返回对应的值，而且每个条件参数也可以借用And或者Or运算符来连接。
当And和Or共用一个参数的时候，尽量采用括号来体现优先顺序。例如
(expression1 And expression2) Or (expression3 And expression4)

6、IF语句是VBA中极为常见的条件语句,用于程序中进行判断,根据条件执行不同的语句.它和工作表函数IF有大大区别,不要混为一谈.
　　IF语句主要有三种句式:
　　1.If …Then…
　　2.IF…Then…Else…
　　3.IF...then

　　…
　　Else

　　….
　　End if
　　本篇重要讲解IF…Then…的语法及案例。
　　“IF…Then…”即如果满足条件则执行指定的语句或者一组语句。如果有多句代码需要利用冒号进行连接。不是函数，而是根据表达式的值有条件地执行一组语句。它的语法如下：
　　IF condition Then [statements]
　　两个参数均为必选参数，缺一不可。其中条件语句必须是数值表达式或字符串表达式，其运算结果为True或False。如果condition 为Null时，则VBA将其视为 False。
　　例如：变量A大于60，则变量B等于“及格”，其表达式为：
　　IF A > 60 Then B = "及格"
　　如果A1单元格字符数超过3个，那么将A1单元格字符加粗再倾斜，表达式如下：
　　IF Len([a1]) >= 3 Then Range("a1").Font.Bold = True: Range("a1").Font.Italic = True
　　IF… Then…语句句式的条件语句与IIF函数中的条件一样也可以使用And和Or运算符来连接多个条件。And与Or运算方参见前一篇文章中的介绍。
　　现通过几个案例展示IF…Then…句式的用法，让读者对它有进一步的认识。
(1)禁止11点以前保存工作簿

　　工作簿中有很多工作表，禁止用户打印工作表以外的任何工作表数据，实现步骤如下：
　　（i）按下快捷键【Alt+F11】进入VBE界面；
　　（ii）如果未显示工程资源管理器，则使用快捷键【Ctrl+G】显示工程资源管理器。然后双击ThisWorkbook进入工作簿事件代码窗口；
　　（iii）在窗口中录入以下事件过程代码：
______________________________________________

Private Sub workbook_BeforeSave(ByVal bSaveAsUI As Boolean, Cancel As Boolean)
If Hour(Now) <= 10 Then MsgBox "禁止保存": Cancel = True
End Sub
_______________________________________________________

　　（iv）返回工作表界面，如果当前时间小于11点，那么单击“保存”按钮时将弹出以下对话框，同时禁止保存工作簿。

　　

　　图35.1禁止11点以前保存工作簿
　　在该事件过程中，“Cancel”参数用于工作簿是否可以保存，如果赋值为True则禁止保存。
　　在本例的条件语句中，符合条件时需要执行两句代码，包括提示及禁止保存，那么两句代码之间必须使用冒号分隔，且必须写在同一行中。
(2)仅仅允许8到18点可以打开当前工作簿
　　某工作簿仅仅允许在早8:00至下午18:00之间可以开启，其它时间开启后则自动关闭。实同步骤如下：
　　（i）按下快捷键【Alt+F11】进入VBE界面；
　　（ii）如果未显示工程资源管理器，则使用快捷键【Ctrl+G】显示工程资源管理器。然后双击ThisWorkbook进入工作簿事件代码窗口；
　　（iii）在窗口中输入以下工作簿打开事件代码：

______

'声明工作簿开启事件
Private Sub Workbook_Open()
'如果现在的小时数大于等于8,而且小于等于18则退出程序
If Hour(Now) >= 8 And Hour(Now) <= 18 Then Exit Sub
'退出Excel程序
Application.Quit
End Sub
_________________________________________________________

　　（iv）保存工作簿后再重新开启，如果当前时间小于8点钟或者大于18点钟，那么工作簿会自动关闭。
　　在该过程中，IF条件语句中有两个条件，只要满足条件之一即退出程序，所以借用And运算符来连接条件。也可以改用Or运算符，那么重编代码如下：

______________________________________________

'声明工作簿开启事件
Private Sub Workbook_Open()
'如果现在的小时数大于等于8,而且小于等于18则退出Excel程序
IF Hour(Now) < 8 or Hour(Now) > 18 Then Application.Quit
End Sub
___________________________________________________________

　　在本过程中，与前一个过程可以实现完全相同的功能，只不过对于条件的处理方式不同。

(3)判断单元格首字符是数值、字母还是汉字
　　根据要求需要进行三次判断，那么本例需要使用三次IF。其代码如下：

_________________________________________________________
Sub 判断()
If [a1] Like "[a-zA-Z]" Then MsgBox "字母"
If Left([a1], 1) Like "[0-9]" Then MsgBox "数字"
If [a1] Like "[一-龥]" Then MsgBox "汉字"
End Sub
__________________________________________________

　　其中Like用来判断字符串是字母、数字还是汉字本最有效率，在对首字符进行数值判断时需要利用left限制。

(4)IF…Then…Else…语句有两种用法，包括条件与满足条件时的执行语句在同一行及条件与满足条件时的执行语句在不同行两种方式，它们的语法分别介绍如下：
　　同行时语法：
IF condition Then [statements][Else elsestatements]
　　其中满足条件时执的语句statements和不满足条件时执行的语句elsestatements都是可选项，不需要“End if”结束。
　　不同行时语法：
IF Condition Then

[statements]
[Else

[elsestatements]]
End IF
　　条件与执行语句不同行时必须以“End IF”结束条件语句，而“Else”则是可选项。
　　从语法上看，条件及执行语句同行与不同行没大多分别，仅仅写法不同。然而实际工作中，不同行的条件语句会占有一些优势，特别是条件有多个或者执行的语句有多句时。
(1)实例：多条件计算奖金
　　例如据图36.1所示的数据计算提金额，条件为业绩大于12万且利润比例大于15%时提成金额为2000元，否则为1000元。
　　
　　图36.1 业绩表
　　完成本题需求有两种解法，其代码如下：

___________________________________________________

Sub 计算奖金1() '同行
Dim i As Byte'从2开始至最后一行个非空行结束
For i = 2 To WorksheetFunction.CountA([B:B])'根据要求设置条件：如果满足条件，提成2000，否则提成1000
IF (Cells(i, "B") > 12 And Cells(i, "C") > 0.15) Then Cells(i, "D") = 2000 Else Cells(i, "D") = 1000
Next i
End Sub

___________________________________________________

Sub 计算奖金2() '不同行
Dim i As Byte

'从2开始至最后一行个非空行结束
For i = 2 To WorksheetFunction.CountA([B:B])
'如果满足条件，那么
IF (Cells(i, "B") > 12 And Cells(i, "C") > 0.15) Then
Cells(i, "D") = 2000 '奖金为200
Else'否则
Cells(i, "D") = 1000'否则奖金为1000
End IF '结束条件语句
Next i
End Sub

___________________________________________________

　　两个过程的执行结果完全一致，但在代码阅读和理解上前一个过程更方便，也显得更简洁。然而在执行语句较多时，多行句式会占有优势。
　　再如，单元格A1的值大于60时，将A1的字体加粗倾斜，并添加红色背景。也有两种解法，见图36.2所示：

　　
　　图36.2　两种条件语句写法的比较
　　从图36.2进行比较，可以看到当有多行语句时，将IF…Then…Else…条件语句写为多行会显示更有条理性和层次感。

第六节数据类型转换

VBA数据类型转换函数 VBA时间函数 vba字符串函数

CBool(expression) 转换为Boolean型

CByte(expression) 转换为Byte型

CCur(expression) 转换为Currency型

CDate(expression) 转换为Date型

CDbl(expression) 转换为Double型

CDec(expression) 转换为Decemal型

CInt(expression) 转换为Integer型

CLng(expression) 转换为Long型

CSng(expression) 转换为Single型

CStr(expression) 转换为String型

CVar(expression) 转换为Variant型

Val(string) 转换为数据型

Str(number) 转换为String

Now 返回一个 Variant (Date)，根据计算机系统设置的日期和时间来指定日期和时间。

Date 返回包含系统日期的 Variant (Date)。

Time 返回一个指明当前系统时间的 Variant (Date)。

Timer 返回一个 Single，代表从午夜开始到现在经过的秒数。

TimeSerial(hour, minute, second) 返回一个 Variant (Date)，包含具有具体时、分、秒的时间。

DateDiff(interval, date1, date2[, firstdayofweek[, firstweekofyear]]) 返回 Variant (Long) 的值，表示两个指定日期间的时间间隔数目

Second(time) 返回一个 Variant (Integer)，其值为 0 到 59 之间的整数，表示一分钟之中的某个秒

Minute(time) 返回一个 Variant (Integer)，其值为 0 到 59 之间的整数，表示一小时中的某分钟

Hour(time) 返回一个 Variant (Integer)，其值为 0 到 23 之间的整数，表示一天之中的某一钟点

Day(date) 返回一个 Variant (Integer)，其值为 1 到 31 之间的整数，表示一个月中的某一日

Month(date) 返回一个 Variant (Integer)，其值为 1 到 12 之间的整数，表示一年中的某月

Year(date) 返回 Variant (Integer)，包含表示年份的整数。

Weekday(date, [firstdayofweek]) 返回一个 Variant (Integer)，包含一个整数，代表某个日期是星期几

Trim(string) 去掉string左右两端空白

Ltrim(string) 去掉string左端空白

Rtrim(string) 去掉string右端空白

Len(string) 计算string长度

Left(string, x) 取string左段x个字符组成的字符串

Right(string, x) 取string右段x个字符组成的字符串

Mid(string, start,x) 取string从start位开始的x个字符组成的字符串

Ucase(string) 转换为大写

Lcase(string) 转换为小写

Space(x) 返回x个空白的字符串

Asc(string) 返回一个 integer，代表字符串中首字母的字符代码

Chr(charcode) 返回 string,其中包含有与指定的字符代码相关的字符

第三章 VAB excel 语句集300句

定制模块行为

(1) Option Explicit '强制对模块内所有变量进行声明

Option Private Module '标记模块为私有，仅对同一工程中其它模块有用，在宏对话框中不显示

Option Compare Text '字符串不区分大小写

Option Base 1 '指定数组的第一个下标为1

(2) On Error Resume Next '忽略错误继续执行VBA代码,避免出现错误消息

(3) On Error GoTo ErrorHandler '当错误发生时跳转到过程中的某个位置

(4) On Error GoTo 0 '恢复正常的错误提示

(5) Application.DisplayAlerts=False '在程序执行过程中使出现的警告框不显示

(6) Application.ScreenUpdating=False '关闭屏幕刷新

Application.ScreenUpdating=True '打开屏幕刷新

(7) Application.Enable.CancelKey=xlDisabled '禁用Ctrl+Break中止宏运行的功能

工作簿

(8) Workbooks.Add() '创建一个新的工作簿

(9) Workbooks(“book1.xls”).Activate '激活名为book1的工作簿

(10) ThisWorkbook.Save '保存工作簿

(11) ThisWorkbook.close '关闭当前工作簿

(12) ActiveWorkbook.Sheets.Count '获取活动工作薄中工作表数

(13) ActiveWorkbook.name '返回活动工作薄的名称

(14) ThisWorkbook.Name ‘返回当前工作簿名称

ThisWorkbook.FullName ‘返回当前工作簿路径和名称

(15) ActiveWindow.EnableResize=False ‘禁止调整活动工作簿的大小

(16) Application.Window.Arrange xlArrangeStyleTiled ‘将工作簿以平铺方式排列

(17) ActiveWorkbook.WindowState=xlMaximized ‘将当前工作簿最大化

工作表

(18) ActiveSheet.UsedRange.Rows.Count ‘当前工作表中已使用的行数

(19) Rows.Count ‘获取工作表的行数(注：考虑向前兼容性)

(20) Sheets(Sheet1).Name= “Sum” '将Sheet1命名为Sum

(21) ThisWorkbook.Sheets.Add Before:=Worksheets(1) '添加一个新工作表在第一工作表前

(22) ActiveSheet.Move After:=ActiveWorkbook. _

Sheets(ActiveWorkbook.Sheets.Count) '将当前工作表移至工作表的最后

(23) Worksheets(Array(“sheet1”,”sheet2”)).Select '同时选择工作表1和工作表2

(24) Sheets(“sheet1”).Delete或 Sheets(1).Delete '删除工作表1

(25) ActiveWorkbook.Sheets(i).Name '获取工作表i的名称

(26) ActiveWindow.DisplayGridlines=Not ActiveWindow.DisplayGridlines '切换工作表中的网格线显示，这种方法也可以用在其它方面进行相互切换，即相当于开关按钮

(27) ActiveWindow.DisplayHeadings=Not ActiveWindow.DisplayHeadings ‘切换工作表中的行列边框显示

(28) ActiveSheet.UsedRange.FormatConditions.Delete ‘删除当前工作表中所有的条件格式

(29) Cells.Hyperlinks.Delete ‘取消当前工作表所有超链接

(30) ActiveSheet.PageSetup.Orientation=xlLandscape

或ActiveSheet.PageSetup.Orientation=2 '将页面设置更改为横向

(31) ActiveSheet.PageSetup.RightFooter=ActiveWorkbook.FullName ‘在页面设置的表尾中输入文件路径

ActiveSheet.PageSetup.LeftFooter=Application.UserName ‘将用户名放置在活动工作表的页脚

单元格/单元格区域

(32) ActiveCell.CurrentRegion.Select

或Range(ActiveCell.End(xlUp),ActiveCell.End(xlDown)).Select

'选择当前活动单元格所包含的范围，上下左右无空行

(33) Cells.Select ‘选定当前工作表的所有单元格

(34) Range(“A1”).ClearContents '清除活动工作表上单元格A1中的内容

Selection.ClearContents '清除选定区域内容

Range(“A1:D4”).Clear '彻底清除A1至D4单元格区域的内容，包括格式

(35) Cells.Clear '清除工作表中所有单元格的内容

(36) ActiveCell.Offset(1,0).Select '活动单元格下移一行，同理，可下移一列

(37) Range(“A1”).Offset(ColumnOffset:=1)或Range(“A1”).Offset(,1) ‘偏移一列

Range(“A1”).Offset(Rowoffset:=-1)或Range(“A1”).Offset(-1) ‘向上偏移一行

(38) Range(“A1”).Copy Range(“B1”) '复制单元格A1，粘贴到单元格B1中

Range(“A1:D8”).Copy Range(“F1”) '将单元格区域复制到单元格F1开始的区域中

Range(“A1:D8”).Cut Range(“F1”) '剪切单元格区域A1至D8，复制到单元格F1开始的区域中

Range(“A1”).CurrentRegion.Copy Sheets(“Sheet2”).Range(“A1”) '复制包含A1的单元格区域到工作表2中以A1起始的单元格区域中

注：CurrentRegion属性等价于定位命令，由一个矩形单元格块组成，周围是一个或多个空行或列

(39) ActiveWindow.RangeSelection.Value=XX '将值XX输入到所选单元格区域中

(40) ActiveWindow.RangeSelection.Count '活动窗口中选择的单元格数

(41) Selection.Count '当前选中区域的单元格数

(42) GetAddress=Replace(Hyperlinkcell.Hyperlinks(1).Address,mailto:,””) ‘返回单元格中超级链接的地址并赋值

(43) TextColor=Range(“A1”).Font.ColorIndex ‘检查单元格A1的文本颜色并返回颜色索引

Range(“A1”).Interior.ColorIndex ‘获取单元格A1背景色

(44) cells.count ‘返回当前工作表的单元格数

(45) Selection.Range(“E4”).Select ‘激活当前活动单元格下方3行，向右4列的单元格

(46) Cells.Item(5,”C”) ‘引单元格C5

Cells.Item(5,3) ‘引单元格C5

(47) Range(“A1”).Offset(RowOffset:=4,ColumnOffset:=5)

或 Range(“A1”).Offset(4,5) ‘指定单元格F5

(48) Range(“B3”).Resize(RowSize:=11,ColumnSize:=3)

Rnage(“B3”).Resize(11,3) ‘创建B3：D13区域

(49) Range(“Data”).Resize(,2) ‘将Data区域扩充2列

(50) Union(Range(“Data1”),Range(“Data2”)) ‘将Data1和Data2区域连接

(51) Intersect(Range(“Data1”),Range(“Data2”)) ‘返回Data1和Data2区域的交叉区域

(52) Range(“Data”).Count ‘单元格区域Data中的单元格数

Range(“Data”). Columns.Count ‘单元格区域Data中的列数

Range(“Data”). Rows.Count ‘单元格区域Data中的行数

(53) Selection.Columns.Count ‘当前选中的单元格区域中的列数

Selection.Rows.Count ‘当前选中的单元格区域中的行数

(54) Selection.Areas.Count ‘选中的单元格区域所包含的区域数

(55) ActiveSheet.UsedRange.Row ‘获取单元格区域中使用的第一行的行号

(56) Rng.Column ‘获取单元格区域Rng左上角单元格所在列编号

(57) ActiveSheet.Cells.SpecialCells(xlCellTypeAllFormatConditions) ‘在活动工作表中返回所有符合条件格式设置的区域

(58) Range(“A1”).AutoFilter Field:=3,VisibleDropDown:=False ‘关闭由于执行自动筛选命令产生的第3个字段的下拉列表

名称

(59) Range(“A1：C3”).Name=“computer” ‘命名A1：C3区域为computer

或Range(“D1：E6”).Name=“Sheet1!book” ‘命名局部变量，即Sheet1上区域D1：E6为book

或 Names(“computer”).Name=“robot” ‘将区域computer重命名为robot

(60) Names(“book”).Delete ‘删除名称

(61) Names.Add Name:=“ContentList”，_

RefersTo:=“=OFFSET(Sheet1!A2,0,0,COUNTA(Sheet2!$A:$A))” ‘动态命名列

(62) Names.Add Name:=“Company”,RefersTo:=“CompanyCar” ‘命名字符串CompanyCar

(63) Names.Add Name:=“Total”,RefersTo:=123456 ‘将数字123456命名为Total。注意数字不能加引号，否则就是命名字符串了。

(64) Names.Add Name:=“MyArray”,RefersTo:=ArrayNum ‘将数组ArrayNum命名为MyArray。

(65) Names.Add Name:=“ProduceNum”,RefersTo:=“=$B$1”,Visible:=False ‘将名称隐藏

(66) ActiveWorkbook.Names(“Com”).Name ‘返回名称字符串

公式与函数

(67) Application.WorksheetFunction.IsNumber(“A1”) '使用工作表函数检查A1单元格中的数据是否为数字

(68) Range(“A:A”).Find(Application.WorksheetFunction.Max(Range(“A:A”))).Activate

'激活单元格区域A列中最大值的单元格

(69) Cells(8,8).FormulaArray=“=SUM(R2C[-1]:R[-1]C[-1]*R2C:R[-1]C)” ‘在单元格中输入数组公式。注意必须使用R1C1样式的表达式

图表

(70) ActiveSheet.ChartObjects.Count '获取当前工作表中图表的个数

(71) ActiveSheet.ChartObjects(“Chart1”).Select ‘选中当前工作表中图表Chart1

(72) ActiveSheet.ChartObjects(“Chart1”).Activate

ActiveChart.ChartArea.Select ‘选中当前图表区域

(73) WorkSheets(“Sheet1”).ChartObjects(“Chart2”).Chart. _

ChartArea.Interior.ColorIndex=2 ‘更改工作表中图表的图表区的颜色

(74) Sheets(“Chart2”).ChartArea.Interior.ColorIndex=2 ‘更改图表工作表中图表区的颜色

(75) Charts.Add ‘添加新的图表工作表

(76) ActiveChart.SetSourceData Source:=Sheets(“Sheet1”).Range(“A1:D5”), _

PlotBy:=xlColumns ‘指定图表数据源并按列排列

(77) ActiveChart.Location Where:=xlLocationAsNewSheet ‘新图表作为新图表工作表

(78) ActiveChart.PlotArea.Interior.ColorIndex=xlNone ‘将绘图区颜色变为白色

(79) WorkSheets(“Sheet1”).ChartObjects(1).Chart. _

Export FileName:=“C：MyChart.gif”,FilterName:=“GIF” ‘将图表1导出到C盘上并命名为MyChart.gif

窗体

(80) MsgBox “Hello!” '消息框中显示消息Hello

(81) Ans=MsgBox(“Continue?”,vbYesNo) '在消息框中点击“是”按钮，则Ans值为vbYes；点击“否”按钮，则Ans值为vbNo。

If MsgBox(“Continue?”,vbYesNo)<>vbYes Then Exit Sub '返回值不为“是”，则退出

(82) Config=vbYesNo+vbQuestion+vbDefaultButton2 '使用常量的组合，赋值组Config变量，并设置第二个按钮为缺省按钮

(83) MsgBox “This is the first line.” & vbNewLine & “Second line.” '在消息框中强制换行，可用vbCrLf代替vbNewLine。

(84) MsgBox "the average is :"&Format(Application.WorksheetFunction.Average(Selection),"#,##0.00"),vbInformation, "selection count average" & Chr(13) '应用工作表函数返回所选区域的平均值并按指定格式显示

(85) Userform1.Show ‘显示用户窗体

(86) Load Userform1 ‘加载一个用户窗体,但该窗体处于隐藏状态

(87) Userform1.Hide ‘隐藏用户窗体

(88) Unload Userform1 或 Unload Me ‘卸载用户窗体

(89) (图像控件).Picture=LoadPicture(“图像路径”) ‘在用户窗体中显示图形

(90) UserForm1.Show 0 或 UserForm1.Show vbModeless ‘将窗体设置为无模式状态

(91) Me.Height=Int(0.88*ActiveWindow.Height) ‘窗体高度为当前活动窗口高度的0.88

Me.Width=Int(0.88*ActiveWindow.Width) ‘窗体宽度为当前活动窗口高度的0.88

事件

(92) Application.EnableEvents=False '禁用所有事件

Application.EnableEvents=True '启用所有事件

注：不适用于用户窗体控件触发的事件

对象

(93) Set ExcelSheet = CreateObject("Excel.Sheet") ‘创建一个Excel工作表对象

ExcelSheet.Application.Visible = True '设置 Application 对象使 Excel 可见

ExcelSheet.Application.Cells(1, 1).Value = "Data" '在表格的第一个单元中输入文本

ExcelSheet.SaveAs "C:\TEST.XLS" '将该表格保存到C:\test.xls 目录

ExcelSheet.Application.Quit '关闭 Excel

Set ExcelSheet = Nothing '释放该对象变量

(94) ‘声明并创建一个Excel对象引用

Dim xlApp As Excel.Application

Dim xlBook As Excel.Workbook

Dim xlSheet As Excel.WorkSheet

Set xlApp = CreateObject("Excel.Application")

Set xlBook = xlApp.Workbooks.Add

Set xlSheet = xlBook.Worksheets(1)

(95) ‘创建并传递一个 Excel.Application 对象的引用

Call MySub (CreateObject("Excel.Application"))

(96) Set d = CreateObject(Scripting.Dictionary) ‘创建一个 Dictionary 对象变量

(97) d.Add "a", "Athens" '为对象变量添加关键字和条目

其他

(98) Application.OnKey “^I”,”macro” '设置Ctrl+I键为macro过程的快捷键

(99) Application.CutCopyMode=False ‘退出剪切/复制模式

(100) Application.Volatile True '无论何时工作表中任意单元格重新计算，都会强制计算该函数

Application.Volatile False '只有在该函数的一个或多个参数发生改变时，才会重新计算该函数

定制模块行为

(101) Err.Clear ‘清除程序运行过程中所有的错误

*******************************************************

工作簿

(102) ThisWorkbook.BuiltinDocumentProperties(“Last Save Time”)

或Application.Caller.Parent.Parent.BuiltinDocumentProperties(“Last Save Time”) ‘返回上次保存工作簿的日期和时间

(103) ThisWorkbook.BuiltinDocumentProperties("Last Print Date")

或Application.Caller.Parent.Parent.BuiltinDocumentProperties(“Last Print Date”) ‘返回上次打印或预览工作簿的日期和时间

(104) Workbooks.Close ‘关闭所有打开的工作簿

(105) ActiveWorkbook.LinkSources(xlExcelLinks)(1) ‘返回当前工作簿中的第一条链接

(106) ActiveWorkbook.CodeName

ThisWorkbook.CodeName ‘返回工作簿代码的名称

(107) ActiveWorkbook.FileFormat

ThisWorkbook.FileFormat ‘返回当前工作簿文件格式代码

(108) ThisWorkbook.Path

ActiveWorkbook.Path ‘返回当前工作簿的路径(注:若工作簿未保存,则为空)

(109) ThisWorkbook.ReadOnly

ActiveWorkbook.ReadOnly ‘返回当前工作簿的读/写值(为False)

(110) ThisWorkbook.Saved

ActiveWorkbook.Saved ‘返回工作簿的存储值(若已保存则为False)

(111) Application.Visible = False ‘隐藏工作簿

Application.Visible = True ‘显示工作簿

注:可与用户窗体配合使用,即在打开工作簿时将工作簿隐藏,只显示用户窗体.可设置控制按钮控制工作簿可见

*******************************************************

工作表

(112) ActiveSheet.Columns("B").Insert ‘在A列右侧插入列，即插入B列

ActiveSheet.Columns("E").Cut

ActiveSheet.Columns("B").Insert ‘以上两句将E列数据移至B列，原B列及以后的数据相应后移

ActiveSheet.Columns("B").Cut

ActiveSheet.Columns("E").Insert ‘以上两句将B列数据移至D列，原C列和D列数据相应左移一列

(113) ActiveSheet.Calculate ‘计算当前工作表

(114) ThisWorkbook.Worksheets(“sheet1”).Visible=xlSheetHidden ‘正常隐藏工作表，同在Excel菜单中选择“格式——工作表——隐藏”操作一样

ThisWorkbook.Worksheets(“sheet1”).Visible=xlSheetVeryHidden ‘隐藏工作表，不能通过在Excel菜单中选择“格式——工作表——取消隐藏”来重新显示工作表

ThisWorkbook.Worksheets(“sheet1”).Visible=xlSheetVisible ‘显示被隐藏的工作表

(115) ThisWorkbook.Sheets(1).ProtectContents ‘检查工作表是否受到保护

(116) ThisWorkbook.Worksheets.Add Count:=2, _

Before:=ThisWorkbook.Worksheets(2)

或 ThisWorkbook.Workshees.Add ThisWorkbook.Worksheets(2), , 2 ‘在第二个工作表之前添加两个新的工作表

(117) ThisWorkbook.Worksheets(3).Copy ‘复制一个工作表到新的工作簿

(118) ThisWorkbook.Worksheets(3).Copy ThisWorkbook.Worksheets(2) ‘复制第三个工作表到第二个工作表之前

(119) ThisWorkbook.ActiveSheet.Columns.ColumnWidth = 20 ‘改变工作表的列宽为20

ThisWorkbook.ActiveSheet.Columns.ColumnWidth = _

ThisWorkbook.ActiveSheet.StandardWidth ‘将工作表的列宽恢复为标准值

ThisWorkbook.ActiveSheet.Columns(1).ColumnWidth = 20 ‘改变工作表列1的宽度为20

(120) ThisWorkbook.ActiveSheet.Rows.RowHeight = 10 ‘改变工作表的行高为10

ThisWorkbook.ActiveSheet.Rows.RowHeight = _

ThisWorkbook.ActiveSheet.StandardHeight ‘将工作表的行高恢复为标准值

ThisWorkbook.ActiveSheet.Rows(1).RowHeight = 10 ‘改变工作表的行1的高度值设置为10

(121) ThisWorkbook.Worksheets(1).Activate ‘当前工作簿中的第一个工作表被激活

(122) ThisWorkbook.Worksheets("Sheet1").Rows(1).Font.Bold = True ‘设置工作表Sheet1中的行1数据为粗体

(123) ThisWorkbook.Worksheets("Sheet1").Rows(1).Hidden = True ‘将工作表Sheet1中的行1隐藏

ActiveCell.EntireRow.Hidden = True ‘将当前工作表中活动单元格所在的行隐藏

注：同样可用于列。

(124) ActiveSheet.Range(“A:A”).EntireColumn.AutoFit ‘自动调整当前工作表A列列宽

(125) ActiveSheet.Cells.SpecialCells(xlCellTypeConstants,xlTextValues) ‘选中当前工作表中常量和文本单元格

ActiveSheet.Cells.SpecialCells(xlCellTypeConstants,xlErrors+xlTextValues) ‘选中当前工作表中常量和文本及错误值单元格

*******************************************************

公式与函数

(126) Application.MacroOptions Macro:=”SumPro”,Category:=4 ‘将自定义的SumPro函数指定给Excel中的“统计函数”类别

(127) Application.MacroOptions Macro:=”SumPro”, _

Description:=”First Sum,then Product” ‘为自定义函数SumPro进行了功能说明

(128) Application.WorksheetFunction.CountA(Range(“A:A”))+1 ‘获取A列的下一个空单元格

(129) WorksheetFunction.CountA(Cell.EntireColumn) ‘返回该单元格所在列非空单元格的数量

WorksheetFunction.CountA(Cell.EntireRow) ‘返回该单元格所在行非空单元格的数量

(130) WorksheetFunction.CountA(Cells) ‘返回工作表中非空单元格数量

(131) ActiveSheet.Range(“A20:D20”).Formula=“=Sum(R[-19]C:R[-1]C”’对A列至D列前19个数值求和

*******************************************************

图表

(132) ActiveWindow.Visible=False

或 ActiveChart.Deselect ‘使图表处于非活动状态

(133) TypeName(Selection)=”Chart” ‘若选中的为图表，则该语句为真，否则为假

(134) ActiveSheet.ChartObjects.Delete ‘删除工作表上所有的ChartObject对象

ActiveWorkbook.Charts.Delete ‘删除当前工作簿中所有的图表工作表

*******************************************************

窗体和控件

(135) UserForms.Add(MyForm).Show ‘添加用户窗体MyForm并显示

(136)TextName.SetFocus ‘设置文本框获取输入焦点

(137) SpinButton1.Value=0 ‘将数值调节钮控件的值改为0

(138) TextBox1.Text=SpinButton1.Value ‘将数值调节钮控件的值赋值给文本框控件

SpinButton1.Value=Val(TextBox1.Text) ‘将文本框控件值赋给数值调节钮控件

CStr(SpinButton1.Value)=TextBox1.Text ‘数值调节钮控件和文本框控件相比较

(139) UserForm1.Controls.Count ‘显示窗体UserForm1上的控件数目

(140) ListBox1.AddItem “Command1” ‘在列表框中添加Command1

(141) ListBox1.ListIndex ‘返回列表框中条目的值，若为-1，则表明未选中任何列表框中的条目

(142) RefEdit1.Text ‘返回代表单元格区域地址的文本字符串

RefEdit1.Text=ActiveWindow.RangeSelection.Address ‘初始化RefEdit控件显示当前所选单元格区域

Set FirstCell=Range(RefEdit1.Text).Range(“A1”) ‘设置某单元格区域左上角单元格

(143) Application.OnTime Now + TimeValue("00:00:15"), "myProcedure" ‘等待15秒后运行myProcedure过程

(144) ActiveWindow.ScrollColumn=ScrollBarColumns.Value ‘将滚动条控件的值赋值给ActiveWindow对象的ScrollColumn属性

ActiveWindow.ScrollRow=ScrollBarRows.Value ‘将滚动条控件的值赋值给ActiveWindow对象的ScrollRow属性

(145) UserForm1.ListBox1.AddItem Sheets(“Sheet1”).Cells(1,1) ‘将单元格A1中的数据添加到列表框中

ListBox1.List=Product ‘将一个名为Product数组的值添加到ListBox1中

ListBox1.RowSource=”Sheet2!SumP” ‘使用工作表Sheet2中的SumP区域的值填充列表框

(146) ListBox1.Selected(0) ‘选中列表框中的第一个条目(注：当列表框允许一次选中多个条目时，必须使用Selected属性)

(147) ListBox1.RemoveItem ListBox1.ListIndex ‘移除列表框中选中的条目

*******************************************************

对象

Application对象

(148) Application.UserName ‘返回应用程序的用户名

(149) Application.Caller ‘返回代表调用函数的单元格

(150) Application.Caller.Parent.Parent ‘返回调用函数的工作簿名称

(151) Application.StatusBar=”请等待……” ‘将文本写到状态栏

Application.StatusBar=”请等待……” & Percent & “% Completed” ‘更新状态栏文本，以变量Percent代表完成的百分比

Application.StatusBar=False ‘将状态栏重新设置成正常状态

(152) Application.Goto Reference:=Range(“A1:D4”) ‘指定单元格区域A1至D4，等同于选择“编辑——定位”，指定单元格区域为A1至D4，不会出现“定位”对话框

(153) Application.Dialogs(xlDialogFormulaGoto).Show ‘显示“定位”对话框，但定位条件按钮无效

(154) Application.Dialogs(xlDialogSelectSpecial).Show ‘显示“定位条件”对话框

(155) Application.Dialogs(xlDialogFormatNumber).show ‘显示“单元格格式”中的“数字”选项卡

Application.Dialogs(xlDialogAlignment).show ‘显示“单元格格式”中的“对齐”选项卡

Application.Dialogs(xlDialogFontProperties).show ‘显示“单元格格式”中的“字体”选项卡

Application.Dialogs(xlDialogBorder).show ‘显示“单元格格式”中的“边框”选项卡

Application.Dialogs(xlDialogPatterns).show ‘显示“单元格格式”中的“图案”选项卡

Application.Dialogs(xlDialogCellProtection).show ‘显示“单元格格式”中的“保护”选项卡

注：无法一次显示带选项卡的“单元格格式”对话框，只能一次显示一个选项卡。

(156) Application.Dialogs(xlDialogFormulaGoto).show Range("b2"), True ‘显示“引用位置”的默认单元格区域并显示引用使其出现在窗口左上角(注：内置对话框参数的使用)

(157) Application.CommandBars(1).Controls(2).Controls(16).Execute ‘执行“定位”话框，相当于选择菜单“编辑——定位”命令

(158) Application.Transpose(Array(“Sun”,”Mon”,”Tur”,”Wed”,”Thu”,”Fri”,”Sat”)) ‘返回一个垂直的数组

(159) Application.Version ‘返回使用的Excel版本号

(160) Application.Cursor = xlNorthwestArrow ‘设置光标形状为北西向箭头

Application.Cursor = xlIBeam ‘设置光标形状为Ⅰ字形

Application.Cursor = xlWait ‘设置光标形状为沙漏(等待)形

Application.Cursor = xlDefault ‘恢复光标的默认设置

(161) Application.WindowState ‘返回窗口当前的状态

Application.WindowState = xlMinimized ‘窗口最小化

Application.WindowState = xlMaximized ‘窗口最大化

Application.WindowState = xlNormal ‘窗口正常状态

(162) Application.UsableHeight ‘获取当前窗口的高度

Application.UsableWidth ‘获取当前窗口的宽度

(163) Application.ActiveCell.Address ‘返回活动单元格的地址(注:返回的是绝对地址)

(164) Application.ActivePrinter ‘返回当前打印机的名称

(165) Application.ActiveSheet.Name ‘返回活动工作表的名称

(166) Application.ActiveWindow.Caption ‘返回活动窗口的标题

(167) Application.ActiveWorkbook.Name ‘返回活动工作簿的名称

(168) Application.Selection.Address ‘返回所选区域的地址

(169) Application.ThisWorkbook.Name ‘返回当前工作簿的名称

(170) Application.CalculationVersion ‘返回Excel计算引擎版本(右边四位数字)及Excel版本(左边两位数字)

(171) Application.MemoryFree ‘以字节为单位返回Excel允许使用的内存数(不包括已经使用的内存)

(172) Application.MemoryUsed ‘以字节为单位返回Excel当前使用的内存数

(173) Application.MemoryTotal ‘以字节为单位返回Excel可以使用的内存数(包括已使用的内存,是MemoryFree和MemoryUsed的总和)

(174) Application.OperatingSystem ‘返回所使用的操作系统的名称和版本

(175) Application.OrganizationName ‘返回Excel产品登记使用的组织机构的名称

(176) Application.FindFormat ‘查找的格式种类

Application.ReplaceFormat ‘替换查找到的内容的格式种类

ActiveSheet.Cells.Replace What:=” “, _

Replacement:=” “,SearchFormat:=True,ReplaceFormat:=True ‘替换查找到的格式

(177) Application.Interactive=False ‘忽略键盘或鼠标的输入

(178) Application.Evaluate("Rate") ‘若在工作表中定义了常量0.06的名称为”Rate”,则本语句将返回值0.06

(179) Application.OnUndo “Undo Option”,“Undo Procedure” ‘选择UndoOption后，将执行Undo Procedure过程

*******************************************************

Range对象

(180) Range(A1:A10).Value=Application.WorksheetFunction.Transpose(MyArray) ‘将一个含有10个元素的数组转置成垂直方向的工作表单元格区域(A1至A10)

注：因为当把一维数组的内容传递给某个单元格区域时，该单元格区域中的单元格必须是水平方向的，即含有多列的一行。若必须使用垂直方向的单元格区域，则必须先将数组进行转置，成为垂直的。

(181) Range(“A65536”).End(xlUp).Row+1 ‘返回A列最后一行的下一行

(182) rng.Range(“A1”) ‘返回区域左上角的单元格

(183) cell.Parent.Parent.Worksheets ‘访问当前单元格所在的工作簿

(184) Selection.Font.Bold=Not Selection.Font.Bold ‘切换所选单元格是否加粗

(185) ActiveSheet.Range("A:B").Sort Key1:=Columns("B"), Key2:=Columns("A"), _

Header:=xlYes ‘两个关键字排序，相邻两列，B列为主关键字，A列为次关键字，升序排列

(186) cell.Range(“A1”).NumberFormat ‘显示单元格或单元格区域中的第一个单元格的数字格式

(187) cell.Range(“A1”).HasFormula ‘检查单元格或单元格区域中的第一个单元格是否含有公式

或cell.HasFormula ‘工作表中单元格是否含有公式

(188) Cell.EntireColumn ‘单元格所在的整列

Cell.EntireRow ‘单元格所在的整行

(189) rng.Name.Name ‘显示rng区域的名称

(190) rng.Address ‘返回rng区域的地址

(191) cell.Range(“A1”).Formula ‘返回包含在rng区域中左上角单元格中的公式。

注：若在一个由多个单元格组成的范围内使用Formula属性，会得到错误；若单元格中没有公式，会得到一个字符串，在公式栏中显示该单元格的值。

(192) Range(“D5:D10”).Cells(1,1) ‘返回单元格区域D5:D10中左上角单元格

(193) ActiveCell.Row ‘活动单元格所在的行数

ActiveCell.Column ‘活动单元格所在的列数

(194) Range("A1:B1").HorizontalAlignment = xlLeft ‘当前工作表中的单元格区域数据设置为左对齐

(195) ActiveSheet.Range(“A2:A10”).NumberFormat=”#,##0” ‘设置单元格区域A2至A10中数值格式

(196) rng.Replace “ “,”0” ‘用0替换单元格区域中的空单元格

*******************************************************

Collection与object

(197) Dim colMySheets As New Collection

Public colMySheets As New Collection ‘声明新的集合变量

(198) Set MyRange=Range(“A1:A5”) ‘创建一个名为MyRange的对象变量

(199) <object>.Add Cell.Value CStr(Cell.Value) ‘向集合中添加惟一的条目(即将重复的条目忽略)

*******************************************************

Windows API

(200) Declare Function GetWindowsDirectoryA Lib “kernel32” _

(ByVal lpBuffer As String,ByVal nSize As Long) As Long ‘API函数声明。返回安装Windows所在的目录名称，调用该函数后，安装Windows的目录名称将在第一个参数lpBuffer中，该目录名称的字符串长度包含在第二个参数nSize中

(201) Set objExcel = CreateObject("Excel.Application")

objExcel.Workbooks.Add ‘创建Excel工作簿

(202) Application.ActivateMicrosoftApp xlMicrosoftWord '开启Word应用程序

(203) Application.TemplatesPath ‘获取工作簿模板的位置

(204) Application.Calculation = xlCalculationManual ‘设置工作簿手动计算

Application.Calculation = xlCalculationAutomatic ‘工作簿自动计算

(205) Worksheets(1).EnableCalculation = False ‘不对第一张工作表自动进行重算

(206) Application.CalculateFull '重新计算所有打开的工作簿中的数据

(207) Application.RecentFiles.Maximum = 5 '将最近使用的文档列表数设为5

(208) Application.RecentFiles(4).Open '打开最近打开的文档中的第4个文档

(209) Application.OnTime DateSerial(2006,6,6)+TimeValue(“16:16:16”),“BaoPo” ‘在2006年6月6日的16:16:16开始运行BaoPo过程

(210) Application.Speech.Speak ("Hello" & Application.UserName) ‘播放声音，并使用用户的姓名问候用户

(211) MsgBox Application.PathSeparator '获取"\"号

(212) MsgBox Application.International(xlCountrySetting) '返回应用程序当前所在国家的设置信息

(213) Application.AutoCorrect.AddReplacement "葛洲坝", "三峡" '自动将在工作表中进行输入的"葛洲坝"更正为"三峡"

(214) Beep '让计算机发出声音

(215) Err.Number ‘返回错误代码

(216) MsgBox IMEStatus '获取输入法状态

(217) Date = #6/6/2006#

Time = #6:16:16 AM# '将系统时间更改为2006年6月6日上午6时16分16秒

(218) Application.RollZoom = Not Application.RollZoom '切换是否能利用鼠标中间的滑轮放大/缩小工作表

(219) Application.ShowWindowsInTaskba = True ‘显示任务栏中的窗口,即各工作簿占用各自的窗口

(220) Application.DisplayScrollBars = True ‘显示窗口上的滚动条

(221) Application.DisplayFormulaBar = Not Application.DisplayFormulaBar '切换是否显示编辑栏

(222) Application.Dialogs(xlDialogPrint).Show ‘显示打印内容对话框

(223) Application.MoveAfterReturnDirection = xlToRight '设置按Enter键后单元格的移动方向向右

(224) Application.FindFile '显示打开对话框

(225) ThisWorkbook.FollowHyperlink http://fanjy.blog.excelhome.net ‘打开超链接文档

(226) ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly '将当前工作簿设置为只读

(227) ActiveWorkbook.AddToFavorites '将当前工作簿添加到收藏夹文件夹中

(228) ActiveSheet.CheckSpelling '在当前工作表中执行"拼写检查"

(229) ActiveSheet.Protect userinterfaceonly:=True ‘保护当前工作表

(230) ActiveSheet.PageSetup.LeftHeader = ThisWorkbook.FullName ‘在当前工作表的左侧页眉处打印出工作簿的完整路径和文件名

(231) Worksheets("Sheet1").Range("A1:G37").Locked = False

Worksheets("Sheet1").Protect

'解除对工作表Sheet1中A1:G37区域单元格的锁定

'以便当该工作表受保护时也可对这些单元格进行修改

(232) Worksheets("Sheet1").PrintPreview '显示工作表sheet1的打印预览窗口

(233) ActiveSheet.PrintPreview Enablechanges:=False ‘禁用显示在Excel的“打印预览”窗口中的“设置”和“页边距”按钮

(234) ActiveSheet.PageSetup.PrintGridlines = True '在打印预览中显示网格线

ActiveSheet.PageSetup.PrintHeadings = True '在打印预览中显示行列编号

(235) ActiveSheet.ShowDataForm '开启数据记录单

(236) Worksheets("Sheet1").Columns("A").Replace _

What:="SIN", Replacement:="COS", _

SearchOrder:=xlByColumns, MatchCase:=True '将工作表sheet1中A列的SIN替换为COS

(237) Rows(2).Delete '删除当前工作表中的第2行

Columns(2).Delete '删除当前工作表中的第2列

(238) ActiveWindow.SelectedSheets.VPageBreaks.Add before:=ActiveCell '在当前单元格左侧插入一条垂直分页符

ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveCell '在当前单元格上方插入一条垂直分页符

(239) ActiveWindow.ScrollRow = 14 '将当前工作表窗口滚动到第14行

ActiveWindow.ScrollColumn = 13 '将当前工作表窗口滚动到第13列

(240) ActiveWindow.Close '关闭当前窗口

(241) ActiveWindow.Panes.Count '获取当前窗口中的窗格数

(242) Worksheets("sheet1").Range("A1:D2").CreateNames Top:=True '将A2至D2的单元格名称设定为A1到D1单元格的内容

(243) Application.AddCustomList listarray:=Range("A1:A8") '自定义当前工作表中单元格A1至A8中的内容为自动填充序列

(244) Worksheets("sheet1").Range("A1:B2").CopyPicture xlScreen, xlBitmap '将单元格A1至B2的内容复制成屏幕快照

(245) Selection.Hyperlinks.Delete ‘删除所选区域的所有链接

Columns(1).Hyperlinks.Delete ‘删除第1列中所有的链接

Rows(1).Hyperlinks.Delete ‘删除第1行中所有的链接

Range("A1:Z30").Hyperlinks.Delete ‘删除指定范围所有的链接

(246) ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, _

Address:="C:\Windows\System32\Calc.exe", ScreenTip:="按下我，就会开启Windows计算器", TextToDisplay:="Windows计算器" '在活动单元格中设置开启Windows计算器链接

(247) ActiveCell.Value = Shell("C:\Windows\System32\Calc.exe", vbNormalFocus) '开启Windows计算器

(248) ActiveSheet.Rows(1).AutoFilter ‘打开自动筛选。若再运行一次，则关闭自动筛选

(249) Selection.Autofilter ‘开启/关闭所选区域的自动筛选

(250) ActiveSheet.ShowAllData ‘关闭自动筛选

(251) ActiveSheet.AutoFilterMode ‘检查自动筛选是否开启，若开启则该语句返回True

(252) ActiveSheet.Columns("A").ColumnDifferences(Comparison:=ActiveSheet. _

Range("A2")).Delete '在A列中找出与单元格A2内容不同的单元格并删除

(253) ActiveSheet.Range("A6").ClearNotes '删除单元格A6中的批注，包括声音批注和文字批注

(254) ActiveSheet.Range("B8").ClearComments '删除单元格B8中的批注文字

(255) ActiveSheet.Range("A1:D10").ClearFormats '清除单元格区域A1至D10中的格式

(256) ActiveSheet.Range("B2:D2").BorderAround ColorIndex:=5, _

Weight:=xlMedium, LineStyle:=xlDouble '将单元格B2至D2区域设置为蓝色双线

(257) Range("A1:B2").Item(2, 3)或Range("A1:B2")(2, 3) ‘引用单元格C2的数据

Range("A1:B2")(3) ‘引用单元格A2

(258) ActiveSheet.Cells(1, 1).Font.Bold = TRUE ‘设置字体加粗

ActiveSheet.Cells(1, 1).Font.Size = 24 ‘设置字体大小为24磅

ActiveSheet.Cells(1, 1).Font.ColorIndex = 3 ‘设置字体颜色为红色

ActiveSheet.Cells(1, 1).Font.Italic = TRUE ‘设置字体为斜体

ActiveSheet.Cells(1, 1).Font.Name = "Times New Roman" ‘设置字体类型

ActiveSheet.Cells(1, 1).Interior.ColorIndex = 3 ‘将单元格的背景色设置为红色

(259) ActiveSheet.Range("C2:E6").AutoFormat Format:=xlRangeAutoFormatColor3 '将当前工作表中单元格区域C2至E6格式自动调整为彩色3格式

(260) Cells.SpecialCells(xlCellTypeLastCell) ‘选中当前工作表中的最后一个单元格

(261) ActiveCell.CurrentArray.Select '选定包含活动单元格的整个数组单元格区域.假定该单元格在数据单元格区域中

(262) ActiveCell.NumberFormatLocal = "0.000; [红色] 0.000" '将当前单元格数字格式设置为带3位小数,若为负数则显示为红色

(263) IsEmpty (ActiveCell.Value) '判断活动单元格中是否有值

(264) ActiveCell.Value = LTrim(ActiveCell.Value) '删除字符串前面的空白字符

(265) Len(ActiveCell.Value) '获取活动单元格中字符串的个数

(266) ActiveCell.Value = UCase(ActiveCell.Value) '将当前单元格中的字符转换成大写

(267) ActiveCell.Value = StrConv(ActiveCell.Value, vbLowerCase) '将活动单元格中的字符串转换成小写

(268) ActiveSheet.Range("C1").AddComment '在当前工作表的单元格C1中添加批注

(269) Weekday(Date) '获取今天的星期,以数值表示,1-7分别对应星期日至星期六

(270) ActiveSheet.Range("A1").AutoFill Range(Cells(1, 1), Cells(10, 1)) '将单元格A1的数值填充到单元格A1至A10区域中

(271) DatePart("y", Date) '获取今天在全年中的天数

(272) ActiveCell.Value = DateAdd("yyyy", 2, Date) '获取两年后的今天的日期

(273) MsgBox WeekdayName(Weekday(Date)) '获取今天的星期数

(274) ActiveCell.Value = Year(Date) '在当前单元格中输入今年的年份数

ActiveCell.Value = Month(Date) '在当前单元格中输入今天所在的月份数

ActiveCell.Value = Day(Date) '在当前单元格中输入今天的日期数

(275) ActiveCell.Value = MonthName(1) '在当前单元格中显示月份的名称,本句为显示"一月"

(276) ActiveCell.Value = Hour(Time) '在当前单元格中显示现在时间的小时数

ActiveCell.Value = Minute(Time) '在当前单元格中显示现在时间的分钟数

ActiveCell.Value = Second(Time) '在当前单元格中显示现在时间的秒数

(277) ActiveSheet.Shapes(1).Delete '删除当前工作表中的第一个形状

(278) ActiveSheet.Shapes.Count '获取当前工作表中形状的数量

(279) ActiveSheet.Shapes(1).TextEffect.ToggleVerticalText '改变当前工作表中第一个艺术字的方向

(280) ActiveSheet.Shapes(1).TextEffect.FontItalic = True '将当前工作表中第一个艺术字的字体设置为斜体

(281) ActiveSheet.Shapes.AddTextEffect(msoTextEffect21, "三峡", _

"Arial Black", 22#, msoFalse, msoFalse, 66#, 80).Select '在当前工作表中创建一个名为"三峡"的艺术字并对其进行格式设置和选中

(282) ActiveSheet.Shapes.AddLine(BeginX:=10, BeginY:=10, EndX:=250, _

EndY:=100).Select '在当前工作表中以(10,10)为起点(250,100)为终点画一条直线并选中

(283) ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _

Left:=70, Top:=40, Width:=130, Height:=72).Select '在当前工作表中画一个左上角在(70,40),宽为130高为72的三角形并选中

(284) ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, _

Left:=70, Top:=40, Width:=130, Height:=72).Select '在当前工作表中画一个以点(70,40)为起点,宽130高72的矩形并选中

(285) ActiveSheet.Shapes.AddShape(Type:=msoShapeOval, _

Left:=70, Top:=40, Width:=130, Height:=72).Select '在当前工作表中画一个左上角在(70,40),宽为130高为72的椭圆

(286) ActiveSheet.Shapes(1).Line.ForeColor.RGB = RGB(0, 0, 255) '将当前工作表中第一个形状的线条颜色变为蓝色

(287) ActiveSheet.Shapes(2).Fill.ForeColor.RGB = RGB(255, 0, 0) '将当前工作表中第2个形状的前景色设置为红色

(288) ActiveSheet.Shapes(1).Rotation = 20 '将当前工作表中的第1个形状旋转20度

(289) Selection.ShapeRange.Flip msoFlipHorizontal '将当前选中的形状水平翻转

Selection.ShapeRange.Flip msoFlipVertical '将当前选中的形状垂直翻转

(290) Selection.ShapeRange.ThreeD.SetThreeDFormat msoThreeD1 '将所选取的形状设置为第1种立体样式

(291) ActiveSheet.Shapes(1).ThreeD.Depth = 20 '将当前工作表中第一个立体形状的深度设置为20

(292) ActiveSheet.Shapes(1).ThreeD.ExtrusionColor.RGB = RGB(0, 0, 255) '将当前工作表中第1个立体形状的进深部分的颜色设为蓝色

(293) ActiveSheet.Shapes(1).ThreeD.RotationX = 60 '将当前工作表中的第1个立体形状沿X轴旋转60度

ActiveSheet.Shapes(1).ThreeD.RotationY = 60 '将当前工作表中的第1个立体形状沿Y轴旋转60度

(294) Selection.ShapeRange.ThreeD.Visible = msoFalse '将所选择的立体形状转换为平面形状

(295) Selection.ShapeRange.ConnectorFormat.BeginDisconnect '在形状中让指定的连接符起点脱离原来所连接的形状

(296) ActiveSheet.Shapes(1).PickUp '复制当前工作表中形状1的格式

(297) ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 260, 160, 180, 30). TextFrame.Characters.Text = "fanjy.blog.excelhome.net" '在工作簿中新建一个文本框并输入内容

(298) ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 80, 100, 200). TextFrame.Characters.Text = "fanjy.blog.excelhome.net" '在当前工作表中建立一个水平文本框并输入内容

(299) ActiveSheet.Shapes.AddPicture "d:\sx.jpg", True, True, 60, 20, 400, 300 '在当前工作表中插入一张d盘中名为sx的图片

(300) ActiveChart.ApplyCustomType xl3DArea '将当前图表类型改为三维面积图

例：删除空白页

Sub GetBlankPage()
Dim IsDelete As Boolean
Dim PageCount As Long
Dim rRange     As Range
Dim iInt     As Integer, DelCount As Integer
Dim tmpstr As String

    IsDelete = True
    PageCount = ThisDocument.BuiltInDocumentProperties(wdPropertyPages)
    For iInt = 1 To PageCount
        '超过PageCount退出
        If iInt > PageCount Then Exit For

        '取每一页的内容
        If iInt = PageCount Then
            Set rRange = ThisDocument.Range( _
                            Start:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, iInt).Start)
        Else
            Set rRange = ThisDocument.Range( _
                            Start:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, iInt).Start, _
                            End:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, iInt + 1).Start _
                            )
        End If

        If Replace(rRange.Text, Chr(13), "") = "" Or Replace(rRange.Text, Chr(13), "") = Chr(12) Then
            tmpstr = tmpstr & "第 " & iInt & " 页是空页" & vbCrLf
            '删除?
            If IsDelete Then
                DelCount = DelCount + 1
                '删除空白页
                rRange.Text = Replace(rRange.Text, Chr(13), "")
                rRange.Text = ""
                '重算页数
                PageCount = ThisDocument.BuiltInDocumentProperties(wdPropertyPages)
                If iInt <> PageCount Then
                    '页删除后，页码变化，重新检查当前页
                    iInt = iInt - 1
                Else
                    '最后一个空页
                    Set rRange = ThisDocument.Range( _
                                    Start:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, PageCount - 1).Start, _
                                    End:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, PageCount + 1).Start _
                                    )
                    '如果是分页符,删除上一页中的换页符
                    If InStr(1, rRange.Text, Chr(12)) > 0 Then
                        rRange.Characters(InStr(1, rRange.Text, Chr(12))) = ""
                    Else
                        '没有分页符,通过选中后删除,最好不这样做，如果判断错误，有误删除的风险
                        Set rRange = ThisDocument.Range( _
                                        Start:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, iInt).Start)
                        rRange.Select
                        Selection.Delete
                    End If
                    Exit For
                End If
            End If
        End If
    Next

    If 1 = 1 Or Not IsDelete Then
        If tmpstr = "" Then
            MsgBox "没有空页", vbInformation + vbOKOnly
        Else
            MsgBox tmpstr, vbInformation + vbOKOnly
        End If
    Else
        If DelCount > 0 Then MsgBox "删除空页 " & DelCount, vbInformation + vbOKOnly
    End If
End Sub

posted @ 2019-01-20 12:20 konglingbin 阅读(5017) 评论(0) 编辑收藏举报

刷新页面返回顶部

konglingbin

excel vba 数据分析

公告