爱华网
Excel VBA之快速上手转载
第一章VBA语言基础
第一节 标识符
一．定义
标识符是一种标识变量、常量、过程、函数、类等语言构成单位的符号，利用它可以完成对变量、常
量、过程、函数、类等的引用。二．命名规则
1） 字母打头，由字母、数字和下划线组成，如A987b_23Abc
2） 字符长度小于 40，（Excel2002以上中文版等，可以用汉字且长度可达254个字符）
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 类型'定义为局部变量，如Dimxyz as integer
Private 变量 as类型 '定义为私有变量，如Private xyz asbyte
Public 变量 as类型 '定义为公有变量，如Public xyz assingle
Global 变量 as类型 '定义为全局变量，如Globlal xyz asdate
Static变量 as类型 '定义为静态变量，如Static xyz asdouble一般变量作用域的原则是，那部份定义就在那部份起作用，模块中定义则在该模块那作用。4）常量为变量的一种特例，用 Const定义，且定义时赋值，程序中不能改变值，作用域也如同变量作用域。 如下定义： ConstPi=3.1415926 as single
第五节 数组
数组是包含相同数据类型的一组变量的集合，对数组中的单个变量引用通过数组索引下标进行。在内存中表现为一个连续的内存块，必须用Global或Dim语句来定义。定义规则如下： Dim 数组名([lower to ]upper [, [lower to ]upper, ….]) as type;Lower缺省值为0。二维数组是按行列排列，如 XYZ(行，列)。
除了以上固定数组外， VBA还有一种功能强大的动态数组，定义时无大小维数堀明；在程序中再利用
Redim语句来重新改变数组大小，原来数组内容可以通过加preserve关键字来保留。如下例：
Dim array1() as double : Redim array1(5) : array1(3)=250 : Redimpreserve array1(5,10)
第六节 注释和赋值语句
1）注释语句是用来说明程序中某些语句的功能和作用；VBA中有两种方法标识为注释语句。9 单引号 ’;如：’定义全局变量；可以位于别的语句之尾，也可单独一行
9 Rem ;如：Rem定义全局变量；只能单独一行 2）赋值语句是进行对变量或对象属性赋值的语句，采用赋值号=，如X=123：Form1.caption=”我的窗口 ” 对对象的赋值采用： setmyobject=object 或myobject:=object
第七节 书写规范
1） VBA不区分标识符的字母大小写，一律认为是小写字母；
2）一行可以书写多条语句，各语句之间以冒号 :分开；
3）一条语句可以多行书写，以空格加下划线 _ 来标识下行为续行；
4）标识符最好能简洁明了，不造成歧义。
第八节 条件语句
1） If…Then…Else语句
If condition Then [statements][Elseelsestatements] 如1：If A>B AndC
如2：If x>250 Thenx=x-100或者，可以使用块形式的语法： If conditionThen [statements] [ElseIfcondition-n Then [elseifstatements]... [Else[elsestatements]] End If
如 1:
If Number < 10ThenDigits = 1 ElseIf Number < 100ThenDigits = 2ElseDigits = 3 End If
2） Select Case…Case…End Case语句如1： Select Case Pid
Case “A101”
Price=200
Case “A102”
Price=300 …… CaseElse
Price=900
End Case
3）Choose 函数
choose(index, choce-1,choice-2,…,choice-n)，可以用来选择自变量串列中的一个值，并将其返回，index
必要参数，数值表达式或字段，它的运算结果是一个数值，且界于 1 和可选择的项目数之间。choice必 要参数， Variant表达式，包含可选择项目的其中之一。如：
GetChoice = Choose(Ind, "Speedy", "United","Federal")
4） Switch函数
Switch(expr-1, value-1[, expr-2, value-2 _ [,expr-n,value-n]])
switch函数和 Choose函数类似，但它是以两个一组的方式返回所要的值，在串列中，最先为 TRUE的值 会被返回。 expr必要参数，要加以计算的 Variant 表达式。value必要参数。如果相关的表达式为 True，则返回此部分的数值或表达式，没有一个表达式为 True， Switch 会返回一个Null值。
第九节 循环语句
1） For Next语句 以指定次数来重复执行一组语句 For counter = startTo end [Stepstep]' step 缺省值为 1 [statements][Exit For] [statements] Next[counter] 如1： For Words = 10 To1 Step-1' 建立 10次循环For Chars = 0 To9' 建立 10次循环MyString = MyString &Chars'将数字添加到字符串中NextChars' Increment counter
MyString = MyString & ""' 添加一个空格 Next Words
2） For Each…Next语句主要功能是对一个数组或集合对象进行，让所有元素重复执行一次语句 For Each elementIn group
Statements [Exit for]Statements
Next [element] 如1： For Eachrang2 In range1
With range2.interior
.colorindex=6.pattern=xlSolid
End with
Next
这上面一例中用到了 With…End With语句，目的是省去对象多次调用，加快速度；语法为：
With object [statements] EndWith
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
第十节 其他类语句和错误语句处理
一．其他循环语句
结构化程序使用以上判断和循环语句已经足够，建议不要轻易使用下面的语句，虽然 VBA还支持。1) Goto line该语句为跳转到line语句行
2) On expression gosub destinatioinlist或者 on expression goto destinationlist 语句为根据exprssion表达式
值来跳转到所要的行号或行标记
3) Gosub line…line…Return语句，Return 返回到 Gosub line行，如下例： Subgosubtry()
Dim num
Num=inputbox(“输入一个数字，此值将会被判断循环 ”)
If num>0 then Gosub Routine1 ：Debug.print num：Exitsub
Routine1:
Num=num/5
Return
End sub 4) while…wend语句，只要条件为TRUE，循环就执行，这是以前VB老语法保留下来的，如下例： whilecondition‘while I<50[statements]‘I=I 1wend‘Wend
二．错误语句处理
执行阶段有时会有错误的情况发生，利用OnError语句来处理错误，启动一个错误的处理程序。语法如下： On Error GotoLine‘当错误发生时，会立刻转移到line行去
On Error ResumeNext‘当错误发生时，会立刻转移到发生错误的下一行去
On Erro Goto0‘当错误发生时，会立刻停止过程中任何错误处理过程
第十一节 过程和函数
过程是构成程序的一个模块，往往用来完成一个相对独立的功能。过程可以使程序更清晰、更具结构
性。VBA具有四种过程：Sub 过程、 Function函数、 Property属性过程和Event事件过程。
一．Sub过程
Sub 过程的参数有两种传递方式：按值传递(ByVal)和按地址传递(ByRef)。如下例：
Sub password (ByVal x as integer, ByRef y asinteger)
If y=100 then y=x y else y=x-y x=x100
End sub
Sub call_password ()
Dim x1 as integer
Dim y1 as integer x1=12y1=100 Call password(x1,y1)‘调用过程方式：1. Call 过程名 (参数 1, 参数 2…) ; 2. 过程名 参数 1, 参数2… debug.printx1,y1‘结果是12、 112， y1按地址传递改变了值，而 x1按值传递，未改变原值
End sub
二． Function函数
函数实际是实现一种映射，它通过一定的映射规则，完成运算并返回结果。参数传递也两种：按值传
递(ByVal)和按地址传递 (ByRef)。如下例：
Function password(ByVal x as integer, byref y as integer) asboolean
If y=100 then y=x y else y=x-y x=x100 if y=150 then password=true elsepassword=false
End Function
Sub call_password ()
Dim x1 as integer
Dim y1 as integer x1=12y1=100 if passwordthen‘调用函数： 1. 作为一个表达式放在=右端 ; 2.作为参数使用 debug.printx1
endif 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)‘指出表达式是否为一个错误值 IsNu ll(expression)‘指出表达式是否不包含任何有效数据 (Null)。
IsObject(identifier)‘指出标识符是否表示对象变量
二．数学函数
Sin(X)、 Cos(X)、 Tan(X)、 Atan(x)三角函数，单位为弧度
Log(x) 返回x的自然对数
Exp(x)返回 ex
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个空白的字符串 As c(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(num ber) 转换为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 VBA常用对象之使用
第一节 文件的操作
1) Excel文件
1.1 新建与打开 一.新建Workbooks.Add
二.打开
Workbooks.Open "路径 /" & "文件名.xls"
三.文件打开对话框的使用
Application.GetOpenFilename(fileFilter:="Excelfiles(*.xls),*.xls,All files (*.*),*.*")
示例 :
flag = False Do While Notflag' 对话框打开已有Excel文件 fm =Application.GetOpenFilename(fileFilter:=" Excel files(*.xls),*.xls,All files (*.*),*.*")
If fm <> FalseThenWorkbooks.OpenfmSet bb =ActiveWorkbook'把bb变量设为当前活动工作簿对象,打开一工作簿时,该工作簿自动为当前活动工作簿flag = TrueEnd If Loop
1.2 保存与关闭 一.保存Workbooks("文件.xls").Save
二.另存对话框的使用
Application.GetSaveAsFilename(fileFilter:="Excel files(*.xls),*.xls,All files (*.*),*.*")
示例 :
flag = False Do While Notflag'循环要求必须输入文件名或选择文件名fm = Application.GetSaveAsFilename(fileFilter:=" Excel files(*.xls),*.xls,All files (*.*),*.*")
If fm <> FalseThenactiveworkbook.SaveAsfm'当前活动工作簿另存flag = TrueEnd If Loop
三.关闭
1.单个文件关闭Workbooks("filename.xls").Close 2.所有该Excel程序打开的文件都关闭Workbooks.Close
如果文件使用中改动过内容 , 那么该命令使用时会弹出提示对话框 , 询问是否保存 .
如果要想不弹出提示对话框,可以使用第三或第四种文件关闭方法 , 或者如下示例 .
示例 :
关闭工作簿“ Book1.xls”，但不提示用户保存所作修订。“Book1.xls”中的所有修订都不 会保存。Application.DisplayAlerts =False'信息警告关闭
Workbooks("BOOK1.XLS").Close
Application.DisplayAlerts =True'信息警告开启
四.关闭同时保存
Workbooks("filename.xls").Closesavechanges:=True
五.关闭同时不保存
Workbooks("filename.xls").Closesavechanges:=False
六 .Excel程序的关闭Application.Quit
说明 :
使用本方法时，如果有未保存的工作簿处于打开状态，则 Microsoft Excel将弹出一个对话 框，询问是否要保存所作修改。
为防止这一情况出现，可在使用 Quit 方法前保存所有的工作簿或将 DisplayAlerts属性设 置为False。如果该属性为 False，则 Microsoft Excel退出时，即使存在未保存的工作簿退出，也不会显示对话框，而且不保存就退出。如果将一个工作簿的 Saved 属性设置为Tr ue，但是并没有将其保存到磁盘上，则 Microsoft Excel在退出时不会提示保存该工作簿。
七.工作簿的密码保护与撤销保护工作簿使其不至被修改。 Workbooks(“工作簿名 ”).Protect(Password, Structure, Windows)
Password Variant类型，可选。为一个字符串，该字符串为工作表或工作簿指定区分大小写的密码。如果省略本参数，不用密码就可以取消对该工作表或工作簿的保护。否则，必须指定密码，通过密码来取消对该工作表或工作簿的保护。如果忘记了密码，就无法取消对该工作表或工作簿的保护。最好在安全的地方保存一份密码及其对应文档名的列表。Structure Variant类型，可选。如果为True，则保护工作簿结构（工作表的相对位置）。默认值为False。
Windows Variant类型，可选。如果为True，则保护工作簿窗口。如果省略本参数，则窗口不受保护如：Workbooks(“学生档案”).protect ”1234”
Workbooks(“学生档案”).Unprotect (Password)
Password Variant类型，可选。指定用于解除工作表或工作簿的保护的密码，此密码是区分大小写的。如果工作表或工作簿不设密码保护则忽略本参数。如果对工作表省略此参数，而该工作表又设有密码保护， Microsoft Excel将提示您要输入密码。如果对工作簿省略此参数，而该工作簿又设有密码保护，本方法将 失败。
1.3 示例
示例 :(使用了4个文件,宏程序文件操作了另外三个文件,还涉及到文件打开另存对话框)
一. 在 test.xls文件中编写一个宏程序test,完成以下内容.打开当前目录下test1.xls 文件,计算 sheet1工作表上单元格 a1到a10的数据剩上(0-1)的随机数,计算结果保存在一个新
建工作簿的 sheet1的 a1到a10上,且结果还要保存在一个任意打开的Excel文件下,示例中打开 test2.xls文件,完成后关闭Excel程序.
test.xls 模块中 Sub test()
Dim i As Integer, flag As Boolean,fm
Dim aa, bb,cc, temp
Application.ScreenUpdating = False'屏幕刷新关闭
Application.DisplayAlerts =False'信息警告关闭
Workbooks.Open ThisWorkbook.Path &"/test1.xls" '打开文件test1.xls
Set aa =ActiveWorkbook.Sheets("Sheet1")
flag =False
Do While Notflag' 对话框打开已有 Excel文件
fm = Application.GetOpenFilename(fileFilter:="Excel files(*.xls),*.xls, _ All files(*.*),*.*")If fm <> FalseThen
Workbooks.Open fm
Set bb = ActiveWorkbook
flag = True
End If
Loop
Workbooks.Add
Set cc =ActiveWorkbook
Withcc.Sheets("Sheet1")
For i = 1 To 10
temp = aa.Cells(i, 1) * Int((10 * Rnd) 1) ' 生成 1 到 10之间的随机数值
.Cells(i, 1) = temp
bb.Sheets(1).Cells(i, 1) = temp
Next
EndWith
flag =False
Do While Notflag' 循环要求必须输入文件名或选择文件名
fm = Application.GetSaveAsFile name(fileFilter:="Excel files(*.xls),*.xl _ s,All files(*.*),*.*")If fm <> FalseThen
cc.SaveAs fm
flag = True
End If
Loop
bb.Save'保存
Set aa = Nothing: Set bb = Nothing: Set cc =Nothing'设置对象变量为空
Application.Quit'关闭Excel
Application.ScreenUpdating =True'屏幕刷新关闭
Application.DisplayAlerts =True'信息警告开启 End Sub
2) 文本文件 2.1 打开与新建 Open语句 能够对文件输入/输出 (I/O)。语法 Open pathname For mode [Access access] [lock]As [#]filenumber [Len=reclength]
Open 语句的语法具有以下几个部分： 部分 描輀pathname 必要。字符串表达式，指定文件名，该文件名可能还包括目录、文件夹及驱动器。mode 必要。关键字，指定文件方式，有 Append、 Binary、 Input、Output、或 Random 方 式。如果未指定方式，则以Random 访问方式打开文件。 access可选。关键字，说明打开的文件可以进行的操作，有Read、Write、或 Read Write 操 作。lock 可选。关键字，说明限定于其它进程打开的文件的操作，有 Shared、LockRead、Lock Write、和 Lock ReadWrite 操作。 filenumber必要。一个有效的文件号，范围在 1 到 511 之间。使用FreeFile 函数可得到下一个 可用的文件号。 reclength可选。小于或等于 32，767（字节）的一个数。对于用随机访问方式打开的文件，该值就是记录长度。对于顺序文件，该值就是缓冲字符数。
说明
对文件做任何 I/O 操作之前都必须先打开文件。 Open 语句分配一个缓冲区供文件进行 I/O之用，
并决定缓冲区所使用的访问方式。
[新建] 如果 pathname指定的文件不存在，那么，在用 Append、 Binary、Output、或 Random 方
式打开文件时，可以建立这一文件。
如果文件已由其它进程打开，而且不允许指定的访问类型，则 Open操作失败，而且会有错误发生。
如果 mode 是 Binary 方式，则 Len子句会被忽略掉。
重要
在 Binary、 Input 和 Random方式下可以用不同的文件号打开同一文件，而不必先将该文件关闭。
在 Append 和 Output方式下，如果要用不同的文件号打开同一文件，则必须在打开文件之前先关闭该 文件。
2.2 读入与写出
2.2.1读入
Input #filenumber, varlist从已打开的顺序文件中读出数据并将数据指定给变量
Get [#]filenumber, [recnumber], varname将一个已打开的磁盘文件读入一个变量之中 2.2.2写入Write #filenumber, [outputlist]
将数据写入顺序文件,以双引号"数据"逗号,分隔数据
Print #filenumber, [outputlist]将格式化显示的数据写入顺序文件中
Put [#]filenumber, [recnumber], varname将一个变量的数据写入磁盘文件中。
2.3关闭
Close [filenumberlist] 关闭 Open 语句所打开的输入/输出 (I/O)文件
注意 :
如果今后想用 Input # 语句读出文件的数据，就要用 Write #语句而不用 Print # 语句将数据写入文件。 因为在使用Write # 时，将数据域分界就可确保每个数据域的完整性，因此可用 Input #再将数据读出来。 使用 Write # 还能确保任何地区的数据都被正确读出。 Write与 Print # 语句不同，当要将数据写入文件 时，Write #语句会在项目和用来标记字符串的引号之间插入逗号。Write # 语句在将 outputlist 中的最后一个字符写入文件后会插入一个新行字符，即回车换行符，(Chr(13) Chr(10))
2.4其他文件函数
LOF(filenumber) 返回一个Long，表示用 Open语句打开的文件的大小，该大小以字节为 单位。EOF(filenumber) 返回一个Integer，它包含 Boolean 值True，表明已经到达为 Random 或顺序 Input打开的文件的结尾。Loc(filenumber)返回一个Long，在已打开的文件中指定当前读/写位置
Seek(filenumber) 返回一个Long，在 Open语句打开的文件中指定当前的读/写位置
2.5 示例
要求: 打开一文本文件 test1.txt, 已知其内容为空格分隔 , 要求把其中每行首个数据写入Excel 宏程序文件 的表1中,再把数据写入新建文件 test2.ini中
Sub test()
Dim Fm, i As Long, j As Long, k AsLong
Dim TT, T1
On Error Resume Next
Fm = Application.GetOpenFilename("Text Files(*.txt), *.txt")
If Fm = False Then ExitSub' 取消选择文件则退出 k =FreeFile
Open Fm For Input As#k' 以随机只读的方式打开文件
f2 = FreeFile
Open "c:/test2.ini" For Output As#f2' 以随机方式新建一个不存在的文件
j = 1
W ithWo rksheets("sheet1")
Do While NotEOF(k)'循环读至文件最后一行Line Input #k,TT' 读入一行数据并将其赋予某变量
T1 =Split(TT)' 以文本中空格来分开这个字符串并赋值给变量,请参考split函数帮助.Cells(j, 1) = T1(0)
Print #f2, T1(0)
j = j 1
Loop
EndW ith
Close#k' 关闭文件
Close#f2' 关闭文件
End Sub
3) Access文件
使用 VBA来访问数据库，其实就是通过一定方法借助数据库引擎来访问，关键是使用什么方法来使
用引擎。目前访问 ACCESS数据库常用的有 DAO和 ADO方法，DAO就是 Database Access Object(数据库访问对象 )的英文缩写， DAO是老式的 , 它目前还在使用的原因是向下兼容和 ADO在一些地方还没有取代 DAO的功能。 ADO是ActiveX DataObject(数据控件对象)的英文缩写，是目前较新和功能较强的方法。
通过 DAO或ADO可以访问多种类型的数据库，包括 Access、SQL Server、 Oracle等，也可访问应用
程序的文件，如Excel文件、文本文件及 Email和 NEWS的文件。实际上利用控件来链接数据库，其概念大致相同，首先都需创建链接，其后用 Open方法产生各种类型的数据集对象，再对数据集对象操作来使用数据库内容。
3.1 DAO使用的步骤及方法 (1). 引用DAO类型库
从 VBE的”工具/引用”菜单中选择可引用“Microsoft DAO 3.6 Object Library”项.
设置DAO数据类型变量
(2). 定义 DAO对象变量
1) Dim db As Database, Database(数据库 )变量对应于 Access数据库.
2) Dim rs As RecordSet, RecordSet(记录集)变量对应于 Access数据库的一个表或子表. 多定义为全局变量，以供程序多处使用。
(3). 打开数据库
Set db = OpenDatabase (Thisworkbooks.path &"/数据库名礀.mdb" ) ‘用 DAO怎么样打开有密码的ACCESS 数据库 Set dbTemp = OpenDatabase("C:/db.mdb",False, False, ";PWD=12345")
(4).打开表或建立表的子表 A. 建立表的子表
Set rs = db.OpenRecordset("select * from表名")
B. 打开表
Set RS = DB.OpenRecordset("表名",dbOpenDynaset)
Opendatabase 方法是打开数据库并返回此数据库的database对象，其语法如下：
Set database的对象变量＝opendatabase ([路径及数据库名礀],[除外性],[只读 ]) 除外性：由true和 false值所构成，当值为true时代表仅允许唯一的使用者使用数据库。 只读：由 true和 false值所构成，为true代表数据库仅提供读取的服务
Openrecordset方法用来创建一个新的 recordset对象，语法为：
Set recordset 对象变量＝数据库变量.openrecordset(来源，种类 )recordset种类有5种，分别为：表（table）、动态集（dynaset）、快照集（snapshot）、动态（dynamic）、正向（forward-only），其中常用的时动态集（dynaset）实际上是引用一个或多个表中数据记录的集合，是功能最强的数据记录集合类型，也是默认值。
(5). 操作数据库记录
对记录的操作就是使用记录集的对象方法和属性来实现，特附录常用属性和方法如下。
记录集对象的属性和方法：
rs.Recordcount属性 用来记录目前数据记录的数量，如判断数据库是否为空 rs.EOF属性 是否是记录的尾 rs.BOF 属性 是否是记录的头rs.Nomatch 属性 返回上次查找成功与否
rs.Move n 方法 移动到第 n 条记录 rs.Movenext 方法移动到下一条记录 rs.MovePrevious 方法移动到上一条记录 rs.Movefirst 方法移动到第一条记录 rs.Lastfirst 方法移动到最后一条记录 rs.Delete 方法 删除当前记录rs.Edit 方法 修改当前记录 (步骤为三步: 1. 用 edit方法设置为修改状态；2. 将数据分别赋到记录的各字 段；3.用Updata方法，把记录更新到数据库中) rs.AddNew 方法添加记录 (添加记录分三步：1.用AddNew方法添加一个新的空白记录；2. 将数据分别赋到记录的各字段；3.用Updata方法，把记录更新到数据库中去) rs.Updata 方法更新内容到数据库中 rs.Findfirst "字段名 = ' "& “查找内容 ” & " '" 方法查找记录中字段与内容相配的首条记录 rs.Findnext 方法查找下一个匹配记录 rs.FindLast 方法查找最后一个匹配记录 rs.FindPrevious方法查找前一个匹配记录 rs.Close 方法 关闭记录集关闭链接
字段集的属性方法:
rs. Fields.Count 属性 字段数目 rs. Fields(n) 第 n 1个字段 ,Fields(0) 表示第一个字段 rs. Fields.Delete(Name AsString) 方法 删除字段 rs. Fields.Append (Object AsObject) 方法 添加字段 rs. Fields.Refresh 方法更新
字段的属性方法 : rs.Fields(n).Name
rs. Fields(n).Size rs.Fields(n).Type rs.Fields(n).Fieldsize rs.Fields(n).value
示例: 打开一个数据库,建立浏览, 查询, 修改, 删除,添加等功能。 OptionExplicit
Public totalRecs As Long, curRecNo AsLong'用于记住 总记录数 和 当前记录号
Public DB1 As Database, RS1 As Recordset
Private SubUserForm_Initialize()'窗口显示
Set DB1 = OpenDatabase(ThisWorkbook.Path& "/pallet.mdb")
Set RS1 =DB1.OpenRecordset("pallet", dbOpenDynaset)
If RS1.EOFAnd RS1.BOF Then
MsgBox "Database is Null."
cmdExit_Click
Else
RS1.MoveLast' 指针移动到最后记录,以便统计记录总数
RS1.MoveFirst
totalRecs = RS1.RecordCount
curRecNo = 1
SetData' 设置窗口参数,按钮是否可用
EndIf End Sub
Private SubcmdFirst_Click()'第一条记录RS1.MoveFirst
curRecNo =1
SetData End Sub
Private SubcmdLast_Click()'最后一条记录RS1.MoveLast
curRecNo =totalRecs
SetData End Sub
Private SubcmdPrevious_Click()'前一条记录RS1.MovePrevious
curRecNo =curRecNo - 1
SetData End Sub
Private SubcmdNext_Click()'下一条记录RS1.MoveNext
curRecNo =curRecNo 1
SetData End Sub
Private SubcmdAdd_Click()'增加一条记录Dim i As Integer
RS1.AddNew
For i = 1 To 5
RS1.Fields(i) = Me.Controls("txt" &i)
Nexti
RS1.Update
totalRecs =totalRecs 1
curRecNo =totalRecs
RS1.MoveLast
SetData End Sub
Private SubcmdDelete_Click()'删除当前记录RS1.Delete
RS1.MoveNext
If RS1.EOF =True Then
RS1.MovePrevious' 指针到底就朝前移
curRecNo = totalRecs - 1
EndIf
totalRecs =totalRecs - 1
SetData End Sub
Private SubcmdModify_Click()'修改当前记录Dim i As Integer
RS1.Edit
For i = 1 To5
RS1.Fields(i) = Me.Controls("txt" &i)
Nexti
RS1.Update End Sub
Private SubcmdFind_Click()' 查找记录,与第一个文本框内容相等
RS1.FindFirst "palletno='" &txt1.Text & "'"
IfRS1.NoMatch Then
MsgBox "Sorry, find Nothing!"
Else
curRecNo = RS1.AbsolutePosition 1
SetData
EndIf End Sub
Private SubcmdClear_Click()'清除显示内容Dim i As Integer
For i = 1 To5
Me.Controls("txt" & i) = ""
Nexti End Sub
Private SubcmdExit_Click()'退出窗口RS1.Close
DB1.Close
UnloadMe
End Sub
SubSetData()'窗口数据设置Dim i As Integer
txtCurRecNo.Text = curRecNo
cmdFirst.Enabled = curRecNo >1
cmdPrevious.Enabled = curRecNo >1
cmdLast.Enabled = curRecNo <totalRecs
cmdNext.Enabled = curRecNo <totalRecs
For i = 1 To5
Me.Controls("txt" & i).Text =RS1.Fields(i)
Next End Sub
3.2 ADO使用的步骤及方法 (1). 引用ADO类型库
从 VBE的”工具/引用”菜单中选择可引用“Microsoft ActiveX Data Object 2.5 Library”项.
(2). 定义和生成ADO对象
1) Dim Cnn As NewADODB.Connection‘数据库连接 Connection对象变量
2) Dim Rst As NewADODB.Recordset‘数据库记录集对象变量
3) Dim Fld AsADODB.Field‘记录字段对象变量
(3). 打开数据库
Cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="& This Workbook.Path &"/CONTACT1.MDB;"用定义生成的数据库连接对象的open方法，打开一个数据库。如果要用ADO打开一个加密码的数据库，方法如下： CNN.Open"provider=Microsoft.jet.OLEDB.4.0;Data Source="& ThisWorkbook.Path& "/CONTACT1.MDB;"& ";Jet OLEDB:DatabasePassword=123"
(4).打开表或建立表的子表
Rst.Open "SELECT 字段名[，字段名] FROM 表名",Cnn, adOpenKeyset,adLockOptimistic用记录集对象的open方法，打开或生成一个数据库的表或子表记录。 如：Rs1.Open"Person", Cnn, adOpenKeyset,adLockOptimistic'取得联系人表所有记录集内容
(5). 操作数据库记录
对记录的操作就是使用记录集的对象方法和属性来实现，属性和方法其实与 DAO的相似，这里就不多说。 看下面示例，尽快学会使用ADO. 示例 : 打开一个数据库,建立浏览, 修改, 删除, 添加和筛选等功能。使用ADO修改和删除记录时，最关键 一条就是主关键字段不能重复，所以我们需要建立主关键字段为自动编号类型 (Access自动编号)，这样就 不会重复，否则出错!
Option Explicit
Public totalRecs As Long, curRecNo AsLong'用于记住 总记录数 和 当前记录号
Public Cnn AsADODB.Connection' 定义全局数据库对象变量
Public Rs1 As ADODB.Recordset
'窗体启动程序
Private SubUserForm_Initialize()Set Cnn = NewADODB.Connection' 创建一个连接和打开 Cnn 连接
Set Rs1 =NewADODB.Recordset' 创建一个记录集
Cnn.Open "Provider=Microsoft.Jet.O LEDB.4.0;DataSour ce=" &ThisWorkbook.Path&"/CONTACT1.MDB;"Rs1.Open "Person", Cnn, adOpenKeyset,adLockOptimistic' 取得联系人表所有记录集内容
Rs1.MoveLast
totalRecs =Rs1.RecordCount
curRecNo =1
Rs1.MoveFirst
Calldis_form' 显示数据记录到窗体 End Sub
'****[第一条]按钮程序 **** Private SubCommandButton1_Click()Rs1.MoveFirstcurRecNo =1Call dis_form End Sub
'****[上一条]按钮程序 **** Private SubCommandButton2_Click()Rs1.MovePreviouscurRecNo = curRecNo -1Call dis_form End Sub
'****[下一条]按钮程序 **** Private SubCommandButton3_Click()Rs1.MoveNextcurRecNo = curRecNo1Call dis_form End Sub
'****[最后一条]按钮程序 **** Private SubCommandButton4_Click()Rs1.MoveLastcurRecNo =totalRecsCall dis_form End Sub
'****[删除]按钮程序 **** Private SubCommandButton5_Click()Rs1.DeletetotalRecs = totalRecs - 1
Rs1.MoveNext
If Rs1.EOF =True Then
Rs1.MovePrevious
curRecNo = curRecNo - 1
EndIf
Rs1.Update' 更新数据记录集，这点与DAO方法不同，DAO删除后不需更新
Calldis_form End Sub
'**** [关闭]按钮 ****
Private SubCommandButton6_Click()Rs1.Close
Cnn.Close
Set Rs1 =Nothing: Set Cnn =Nothing' 删除对象
UnloadMe' 关闭窗体 End Sub
'****[更新]按钮程序 **** Private SubCommandButton8_Click()On Error ResumeNextRs1.Fields(1) =TextBox1.TextRs1.Fields(2) =TextBox2.TextRs1.Fields(3) =TextBox3.TextRs1.Fields(4) =TextBox4.TextRs1.Fields(5) =TextBox5.TextRs1.Fields(6) =TextBox6.TextRs1.Fields(7) =TextBox7.TextRs1.Fields(8) =TextBox8.TextRs1.Update End Sub'****[查找]按钮程序 **** Private SubCommandButton10_Click()Dim Rs2 As NewADODB.RecordsetDim i As Integer Rs2.Open "select * from personwhere 联系人编号 like " &TextBox1.Text, Cnn, adOpenKeyset,adLockOptimistic‘SQL语言使用，查询生成新的记录集If Rs2.EOF And Rs2.BOFThenMsgBox "Notfind!"ElseSheets(1).Cells.ClearContentsFor i = 0 To Rs2.Fields.Count -1Sheets(1).Cells(1, i 1) =Rs2.Fields(i).NameNextSheets(1).Cells(2, 1).CopyFromRecordsetRs2MsgBox "The find result is displayed inExcel."End If
Rs2.Close
Set Rs2 =Nothing End Sub
'****[添加]按钮程序 **** Private SubCommandButton9_Click()Rs1.AddNew'添加一条记录，注意Fields(0)字段为主键且 Access自动编号，这可以保证添加内容可以重复，否则出错totalRecs = totalRecs1Rs1.Fields(1) =TextBox1.TextRs1.Fields(2) =TextBox2.TextRs1.Fields(3) =TextBox3.TextRs1.Fields(4) =TextBox4.TextRs1.Fields(5) =TextBox5.TextRs1.Fields(6) =TextBox6.TextRs1.Fields(7) =TextBox7.TextRs1.Fields(8) =TextBox8.TextRs1.UpdatecurRecNo =totalRecsCall dis_form End Sub
'****在窗体上显示当前记录***** Private Subdis_form()TextBox1.Text =Rs1.Fields(1)TextBox2.Text =Rs1.Fields(2)TextBox3.Text =Rs1.Fields(3)TextBox4.Text =Rs1.Fields(4)TextBox5.Text =Rs1.Fields(5)TextBox6.Text =Rs1.Fields(6)TextBox7.Text =Rs1.Fields(7)TextBox8.Text =Rs1.Fields(8)CommandButton1.Enabled = curRecNo >1CommandButton2.Enabled = curRecNo >1CommandButton3.Enabled = curRecNo <totalRecsCommandButton4.Enabled = curRecNo <totalRecsTextBox9 = curRecNo EndSub
(6).数据库使用 SQL查询语言
数据库一般都提供了关连式数据库的查询语言 SQL (Structured Query Language)，它是一种非常口语
化、既易学又易懂的语法。此语言几乎是每个数据库系统都必须提供的，用以表示关连式的操作，包含了 资料的定义 (DDL)以及资料的处理(DML)。
对于SQL语言的使用，请参考别的专业教程，本文就简约介绍一下，示例中也仅用到一点SQL语言。
（6.1）资料定义 DDL（Data DefinitionLanguage）
资料定义语言是指对资料的格式和形态下定义的语言，他是每个数据库要建立时候时首先要面对的，举凡资料分哪些表格关系、表格内的有什么字段元主键、表格和表格之间互相参考的关系等等，都是在开始的时候所必须规划好的。 如建表格：Create Tabletable_name (column1 DATATYPE [NOT NULL] [NOT NULL PRIMARYKEY], column2 DATATYPE [NOTNULL],...)
（6.2）资料操作 DML（Data Manipulation Language)
资料定义好之后接下来的就是资料的操作。资料的操作不外乎增加资料（ insert)、 查询资料（ query）、 更改资料（update） 、删除资料（ delete）四种模式，以下分别介绍他们的语法： 增加资料：INSERT INTO table_name (column1,column2,...) VALUES (value1,value2, ...) 查询资料： SELECT * FROMtable_name WHERE conditions 更改资料：UPDATEtable_name SET column1=''xxx'' WHERE conditoins删除资料： DELETE FROM table_name WHEREconditions
4) 文件其它操作 4.1) 判断文件存在
使用 Dir 函数判断 , 格式: Dir[(pathname [,attributes] ) ] Dir 会返回匹配 pathname 的第一个文件名。示例如下.strfile = Dir(ThisWorkbook.Path &"/filename.xls")'检查文件是否存在 If strfile<> ""Then‘存在就打开Workbooks.Open ThisWorkbook.Path &"/filename.xls" Else‘文件不存在就警告MsgBox "文件不存在 ", vbOKOnly, "警告" EndIf
4.2) 搜查文件
使用 Application.FileSearch方法 示例如下: pp = "D:/Temp": ff =0 WithApplication.FileSearch.NewSearch.LookIn = pp.Filename = "prn*.tmp" ‘查找文件prn*.tmp *为指代符
If .Execute() > 0 Then ff =.FoundFiles.Count
End With
MsgBox pp & " 找到 "& ff & " 个档案!"
4.3) 删除文件 使用 kill方法 示例如下 :kill(“c:/mytest.txt”)
4.4) 取得文件日期属性
使用 FileSystem object对象实现 ,示例函数如下
Function FileDate(filespec, datetype)
Dim fs, f, s
Set fs =CreateObject("Scripting.FileSystemObject")
Set f =fs.GetFile(filespec)Select CasedatetypeCase 1: FileDate =f.DateCreated'档案建立日期Case 2: FileDate =f.DateLastAccessed'存取日期Case 3: FileDate =f.DateLastModified'修改日期 EndSelect End Function
4.5) FileSystemObject文件系统对象的使用
FileSystemObject (FSO，下面简礀为 FSO) 对象模型，具有大量的属性、方法和事件，使用面向对象
的“ object.method”语法，来处理文件夹和文件，可以在Office 2000 以后版本使用。FileSystemObject 并 不是 VBA 的一部分，它是以一个 COM 组件的形式提供，可以在VB、 VBA、VBScript 中使用。
FSO对象模型可以创建、改变、移动和删除文件夹，或探测特定的文件夹是否存在，若存在，还可以
找出有关文件夹的信息，如名礀、被创建或最后一次修改的日期，等等。 FSO 对象模型还使文件处理变得很容易。可以创建文件，插入和改变数据，以及输出（读取）数据。 FSO 对象模型，支持通过TextStream 对象来创建和操作文本文件，但不支持二进制文件的创建或操作，这可以用VBA语句完成。
使用 FileSystemObject 对象模型进行文件操作的步骤是： 1.使用 CreateObject 方法来创建FileSystemObject 对象；
2. 在新创建的对象上使用适当的方法；
3. 访问对象的属性。
下面代码显示如何创建 FileSystemObject 实例：Dim fso
Set fso =CreateObject("Scripting.FileSystemObject")在这个示例中， Scripting 是类型库的名字，而 FileSystemObject则是想要创建的对象的名字。
使用 FSO 处理文件夹的任务和方法创建文件夹FileSystemObject.CreateFolder删除文件夹Folder.Delete 或 FileSystemObject.DeleteFolder移动文件夹Folder.Move 或 FileSystemObject.MoveFolder复制文件夹Folder.Copy 或 FileSystemObject.CopyFolder检索文件夹Folder.Name如果文件夹在驱动器上存在，则找出它FileSystemObject.FolderExists 获得现有Folder对象的实例FileSystemObject.GetFolder找出文件夹的父文件夹名FileSystemObject.GetParentFolderName找出系统文件夹的路径FileSystemObject.GetSpecialFolder
FSO 中写数据到文本文件的方法
向打开的文本文件写数据，不用后续一个新行字符Write
向打开的文本文件写数据，后续一个新行字符WriteLine
向打开的文本文件写一个或多个空白行WriteBlankLines
FSO 中读取文本文件的方法
从文件读取指定数量的字符Read
读取一整行（一直到但不包括新行字符）ReadLine
读取文本文件的整个内容ReadAll
FSO 中移动、复制和删除文件的方法 移动文件File.Move 或 FileSystemObject.MoveFile复制文件 File.Copy 或FileSystemObject.CopyFile 删除文件 File.Delete 或FileSystemObject.DeleteFile
使用 FSO 处理文件、文件夹比使用 VBA 语句的方法具有更易操作的特点， FSO 除了不能处理二进制文件，其文件和文件夹处理的方法也更完备，更直观和易于使用。
第二节 工作表操作
在文件操作一节已经讲了Excel工作簿文件的打开、新建、保存和关闭了，这里再讲文件下的表格操作。1) 新建与删除新建工作表、图表或宏表。新建的工作表将成为活动工作表。 Sheets.Add (Before,After, Count, Type) 说明：
Before Variant类型，可选。指定工作表对象，新建的工作表将置于此工作表之前。
After Variant类型，可选。指定工作表对象，新建的工作表将置于此工作表之后。
Count Variant类型，可选。要新建的工作表的数目。默认值为 1。
Type Variant类型，可选。指定工作表类型。可为以下 XlSheetType 常量之一： xlWorksheet、xlChart、 xlExcel4MacroSheet 或xlExcel4IntlMacroSheet。默认值为xlWorksheet。 如果 Before 和 After两者均省略，则新建的工作表将插入到活动工作表之前。 示例： Sheets.Addafter:=Sheets(Sheets.Count)该语句可以在最后一个工作表后增加一个新表
删除工作表
Sheets(“工作表名 ”).Delete示例：在工作表末新建一个和删除倒数第二个表。
Sub MySht()
Application.DisplayAlerts =False'关闭删除确认对话框
Sheets.Addafter:=Sheets(Sheets.Count)
Sheets(Sheets.Count - 1).Delete
Application.DisplayAlerts =True'开启确认对话框 End Sub
2) 隐藏与显示
使用工作表的 visible属性来设置工作表是否隐藏或显示隐藏 Sheets ("sheet2").Visible =False 显示 Sheets("sheet2").Visible =True
3)保护与撤销
保护工作表使其不至被修改。
Sheets(“工作表名 ”).Protect(Password)
撤销工作表保护使其被修改。
Sheets(“工作表名 ”).Unprotect(Password)
Password Variant类型，可选。为一个字符串，该字符串为工作表或工作簿指定区分大小写的密码。如果省略本参数，不用密码就可以取消对该工作表或工作簿的保护。否则，必须指定密码，通过密码来取消对该工作表或工作簿的保护。
示例： Sheets(“sheet1”).Protect “123456”Sheets(“sheet1”).Unprotect “123456”
如果要对工作进行详细保护设置，可参考Excel VBA参考，这里仅讲简单的参数设置。
第三节 单元格和区域操作
Excel数据的计算归根到底还是对表的单元进行的，所以单元格和区域操作非常重要的，这一节就详
细介绍这方面的内容。
一、如何引用单元格和区域
1）用 Range属性引用单元格和单元格区域 使用 Range属性来引用 A1引用样式中的单元格或单元格区域及进行属性更改和赋值。如例句：Sheets("Sheet1").Range("A1:D5").Font.Bold =True
Sheets("Sheet1").Range("A1:D5").Value =10000
Range 对象既可表单个单元格，也可表单元格区域。下面说明 Range对象最常用方法。
引用含义Range("A1")单元格 A1
Range("A1:B5")从单元格 A1 到单元格 B5的区域
Range("C5:D9,G9:H16")多块选定区域
Range("A:A")A 列
Range("1:1")第一行
Range("1:5")从第一行到第五行的区域
Range("1:1,3:3,8:8")第 1、 3 和 8行
Range("A:C")从 A 列到 C列的区域
Range("A:A,C:C,F:F")A 、 C 和 F列
Range("单元格区域名礀 ")命名的单元格区域
2）用 Cells属性引用单元格
可用 Cells 属性通过行列编号来引用单个单元格。下例中 Cells(6,1) 返回 Sheet1 上的单元格A6，然后将 Value 属性设置为10。如：Worksheets("Sheet1").Cells(6, 1).Value = 10因为可用变量替代行列编号，所以 Cells属性非常适合单元格区域中循环且速度很快。如下例所示： SubCC()Dim Counter AsIntegerFor Counter = 1 To20Worksheets("Sheet1").Cells(Counter, 3).Value =CounterNext Counter End Sub
3）用 Rows或Columns属性引用行列
可用 Rows 属性或 Columns 属性来处理整行或整列。下例中，用 Rows(1) 返回 Sheet1上的第一行，然
后将单元格区域的 Font 对象的 Bold属性设置为 True。如：Worksheets("Sheet1").Rows(1).Font.Bold =True
下表举例说明了使用 Rows 和 Columns属性的一些行和列的引用。引用含义Rows(1)第一行
Rows工作表上所有的行
Columns(1)第一列
Columns("A")第一列
Columns工作表上所有的列
4）用 Union方法合并区域后引用
若要同时处理若干行或列及区域，请创建一个对象变量并使用 Union 方法，将对多个区域组合起来。下例将活动工作簿中第一张工作表上的第一行、第三行和第五行的字体设置为加粗。 SubSeveralRows()Worksheets("Sheet1").ActivateDim myUnion AsRangeSet myUnion = Union( Rows(1), Rows(3),Rows(5))myUnion.Font.Bold = True EndSub
5）用括号 [ ]引用单元格和区域
可用方括号将 A1 引用样式或命名区域括起来，作为 Range 属性的快捷方式。这样就不必键入单词“Range”或使用引号，如下例所示：Worksheets("Sheet1").[A1:B5].ClearContents[MyRange].Value = 30
6) 用 Offset相对其他单元格来引用单元格
处理相对于另一个单元格的某一单元格的常用方法是使用Offset 属性。下例中，将位于活动工作表上活动单元格下一行和右边三列的单元格的内容设置为双下划线格式。如：ActiveCell.Offset(1, 3).Font.Underline =xlDouble
7) 用 Selection 属性引用活动区域
Select 方法激活工作表和工作表上的对象；而 Selection属性返回代表活动工作簿中活动工作表上的当前 选定区域的对象。在成功使用 Selection属性之前，必须先激活工作簿，并激活或选定工作表，然后用Select 方法选定单元格区域（或其他对象）。
宏录制器经常创建使用 Select 方法和 Selection属性的宏。下輀 Sub 过程是用宏录制器创建的，该过程 演示了Select 方法和 Selection 属性在一起使用的方法。
Sub Macro1()
Sheets("Sheet1").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "Name"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Address"
Range("A1:B1").Select
Selection.Font.Bold = True
End Sub
8）区域中循环引用单元格方法
使用 VBA时，经常需要对某一单元格区域内的每个单元格运行同一段语句。为达到这一目的，可组
合循环语句和一个或多个方法来标识每个单元格，一次针对一个单元格，并执行该操作。
8.1) For...Next 循环语句与 Cells属性配合使用
使用 Cells属性时，可用循环计数器（或其他变量或表达式）来替代单元格索引编号。下例中变量
counter 代替行号。此过程在单元格区域 C1:C20 中循环，将绝对值小于0.01的单元都置为 0。
SubRoundToZero1()For Counter = 1 To 20
If Abs(Cells(counter,3).value) < 0.01 ThenCells(counter,3) = 0
Next End Sub
8.2) For Each...Next 循环语句和 Range 属性配合使用示例如下： SubRoundToZero2()For Each c In Worksheets("Sheet1").Range("A1:D10").CellsIf Abs(c.Value) < 0.01 Then c.Value =0Next End Sub
二、如何处理单元格和区域1 处理三维区域如果要处理若干工作表上相同位置的单元格区域，可用 Array函数选定两张或多张工作表。下例设置三 维单元格区域的边框格式。 SubFormatSheets()Sheets (Array("Sheet2", "Sheet3","Sheet5")).SelectRange("A1:H1").SelectSelection.Borders(xlBottom).LineStyle = xlDoubleEnd Sub
2处理活动单元格
ActiveCell 属性返回代表活动单元格的 Range对象。可对活动单元格应用 Range 对象的任何属性和方法，如下例所示。
Sub SetValue()
Worksheets("Sheet1").Activate
ActiveCell.Value = 35 End Sub注意只有活动单元格所在的工作表处于活动状态时，才能处理该活动单元格。
3 选择活动单元格周围的单元格
CurrentRegion 属性返回由空白行和空白列所包围的单元格区域。下例中，选定区域扩充到与活动单元格
相邻的包含数据的单元格中，然后用“货币”样式设置该区域的格式。SubRegion()Worksheets("Sheet1").ActivateActiveCell.CurrentRegion.SelectSelection.Style = "Currency" EndSub
4 单元格和区域赋值
用赋值号 ＝ 赋值，如给 A1赋值为 10：Range(A1).Value=10 (由于 Value是默认属性，所以可以直接省略) 区域赋值，如 Range(A1:D5)=10
5 单元格和区域赋予公式进行计算
把公式字符串赋予给单元格或区域的 Formula属性，如下例 :注意一点是公式字符串中要有开头的等号＝。 SubEnterFormula()Worksheets("Sheet1").Range("D6").Formula ="=SUM(D2:D5)" End Sub
三、单元格和区域的定位
1) 使用单元格的 End属性来定位边界 如：数据区域的最下行的确定： Sheets(1).cells(65536,1).End(xlup).Row数据区域的最右列的确定：Sheets(1).cells(1,1).End(xltoright).Column选定包含单元格“ B4”的区域在 B 列中顶端的单元格：Range("B4").End(xlUp).Select 选定包含单元格“B4”的区域在第 4 行中最右端的单元格:Range("B4").End(xlToRight).Select 将选定区域从单元格“B4”延伸至第四行最后一个包含数据的单元格 :Range("B4", Range("B4").End(xlToRight)).Select
2) 善用已用区域UsedRange对象来获得区域范围如：需要获得先前表格已用区域的最右下角单元格位置 Sub Loc()
temp = [a1] ：[a1] =1‘ 使用 A1单元格，保证已用区域从A1开始 irow =ActiveSheet.UsedRange.Rows.Count‘右下单元格行 icol =ActiveSheet.UsedRange.Columns.Count‘右下单元格列 [a1] =temp‘ 还原 A1的值 Cells(irow,icol).Select‘ 选中右下角单元格
End sub
四、单元格和区域的保护与锁定
1）工作表选择改变事件过程中保护，如下：不许可用户选择及改动保护单元格区域，示例中保护B1:B10 Private SubWorksheet_SelectionChange(ByVal Target AsRange)Dim rng AsRangeSet rng =Range("b1:b10")If Intersect(Target, rng) Is Nothing Then ExitSub ‘选择单元不在保护区内就退出MsgBox "不可以选取单元格！" &Target.Address‘选择单元在保护区内就改变选择ActiveSheet.Range("a1").Select EndSub
2）通过行列的隐藏来保护
本示例隐藏工作表“ Sheet1”的第5行和C列 SubSetHide()
WithWorksheets("Sheet1")‘ 使用With …End With语句块，提高效率.Unprotect‘ 撤销保护，如果原先未保护则不需该句 .Rows(5).Hidden =True‘ 隐藏第5行 .Columns("C").Hidden =True‘ 隐藏C列.Protect‘ 启动保护，如果原先未保护则不需该句 Endwith
End Sub
3）通过锁定区域来保护，可限定未锁定区域内输入 SubSetLock()ActiveSheet.UnprotectCells.Locked =True‘ 锁定全表
Range("a1:b10").Locked=false‘ 解锁区域 A1:B10，限定该区域为可输入区
ActiveSheet.Protect EndSub
第四节 图表的操作
Excel让人喜爱的原因就是它有强大得计算功能和数图相关联的数据作图功能。本节就介绍下 VBA代码作图方面内容。通过代码作重复的图，可以大大提高效率，比如我的作品 GeoPlot（www.geoplot.net）。Excel图的代码绘制，最好是学习录制的宏来分析VBA代码的作用，最后优化而成通用程序块。
一．新建及类型
1）设置一个对象等于新增图表对象就建立好了一个新图
1.1) 新图赋值给对象变量
Set mychart = Sheets(1).ChartObjects.Add (ChrLeft, ChrTop,ChrWidth, ChrHeight)
说明：增加一个嵌入图表，其左上角的位置坐标为（ ChrLeft, ChrTop），长宽为ChrWidth×ChrHeight， 单位为磅。1磅为 1/72 英寸和 0.035厘米，字体大小通常用磅数量度。 1.2)直接增加一个图对象到图对象集Charts
Charts.A dd
2）图的类型可以更改 Chart对象的属性 ChartType来实现
2.1）图表对象变量的使用
mychart.Chart.ChartType =xlXYScatterLines' 散点图折线类型
2.2）未设置对象变量的图
它的类型更改需要在增加它后，连续操作让它处于激活状态（ ActiveChart），这样可通过当前活动
图ActiveChart来使用。如：ActiveChart.ChartType =xlPie‘饼图
3）图表有两大类，一是嵌入工作表上的图，另一类是作为新工作表图，其设置如下：
3.1）嵌入工作表上的图
ActiveChart.Location Where:=xlLocationAsObject, Name:= "Sheet1"或如1.1生成新图时就定义为
生成嵌入图ChartObjects.Add
3.2）新工作表图
ActiveChart.Location Where:=xlLocationAsNewSheet或用图表对象变量属性更改mychart.location
where:= xlLocationAsNewSheet
二．设置图表的数据
一般是使用 Excel表格上数据，所以可以通过设置 Chart图表对象的数据来源属性来获得作图需要的
数据。如：ActiveChart.SetSource DateSource:=Sheets("Sheet1").Range("A1:B6"), PlotBy:=xlColumns 这里的 PlotBy:=xlColumns表示按列绘制数据；也可以按行绘制，其参数为PlotBy:=xlRows。
另外一种数据设置是对图的横、纵坐标数据分别赋值。如：
mychart.chart.SeriesCollection.NewSeries‘ 增加一个系列数据
mychart.chart.SeriesCollection(1).XValues = Array(45,100)‘ 横坐标数据组或单元对象
mychart.chart.SeriesCollection(1).Values = Array(50,180)‘ 纵坐标数据组或单元对象
三．图表格式设置
对于图的格式设置，一般是录制一个宏，再删除不需要的语句，这样是开发者最省事的方法。在本节
的示例中有详细的格式设置，可以更改坐标轴的名礀，大小范围，刻度大小等。对不清楚的图的类型名礀，格式参数，我们都可以通过录制宏来了解学习。时刻记住，录制宏来分析代码，是最好的学习方法。
四．散点图增加一个系列和增加文字标签
1）用图表的系列集合对象的方法NewSeries，就可以增加图的系列，然后再对新系列进行设置，如下：
mychart.chart.SeriesCollection.NewSeries‘ 增加一个系列数据mychart.chart.SeriesCollection(1).XValues = Array(45,100)‘横坐标数据组或单元对象mychart.chart.SeriesCollection(1).Values = Array(50,180)‘ 纵坐标数据组或单元对象
2）对于散点图，我们可以增加文字标签于图上，方法如下：增加一个新的系列，不过数据就一点，不显示数据点，而仅显示它的数据标签即可。如下示例。Withmychart.chart.SeriesCollection(2).MarkerStyle =xlNone'不显示点标记.Points(1).HasDataLabel =True'数据标记及显示文字标签.Points(1).DataLabel.Text=”标签文字”'标签文字.DataLabels.Position =xlLabelPositionCenter' 位置风格，居中
End With
五．实例
1） 生成一个散点嵌入图于工作表窗口中心，绘制一条直线（45,50）— (100,180),在第一点显示文字标签
“Test”，此外还加一个点（ 80， 100）。
代码和详细注释如下：
Sub DrawChart()
'*******************************图表对象的定义和生成***********************************'定义对象变量，以便设置它为图表（ chart）对象及图位置大小变量
Dim mychartAs Object, mysheet As Object
Dim ChrLeft As Long, ChrTop As Long, ChrWidth AsLong, ChrHeight As Long
On ErrorResume Next
Application.ScreenUpdating = False
ChrWidth = 250:ChrHeight = 250
ChrLeft = Abs(Windows(ThisWorkbook.Name).Width -ChrWidth) / 2
ChrTop =Abs(Windows(ThisWorkbook.Name).Height - ChrHeight) /2 ' 计算图表在窗口中心坐标
Set mychart= Sheets(1).ChartObjects. Add(ChrLeft, ChrTop, ChrWidth,ChrHeight)
Withmychart.Chart
.ChartType =xlXYScatterLines' 散点折线图类型
.SeriesCollection.NewSeries' 增加一次投点,画条直线
.SeriesCollection(1).XValues = Array(45,100)
.SeriesCollection(1).Values = Array(50,180)
.SeriesCollection(1).Points(1).HasDataLabel =True' 点1是否显示数据标签
.SeriesCollection(1).Points(1).DataLabel.Text ="Test"' 点1的标签文字
.SeriesCollection.NewSeries' 增加一次投点,就投个点（ 80，100）
.SeriesCollection(2).XValues = 80
.SeriesCollection(2).Values = 100
EndWith'*******************************图表风格定义***********************************With mychart.Chart
.ChartArea.Font.Size =10' 图表字符的大小
.HasLegend =False' 图是否显示图例
.Axes(xlCategory, xlPrimary).HasTitle =True'X 轴是否有坐标名
.Axes(xlCategory, xlPr imary).AxisTitle.Characters.Text ="X"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrim ary).AxisTitle.Characters.Text = "Y"'Y轴坐标名"Y"
.PlotArea.Interior.ColorIndex =xlNone' 定义投图区为透明
EndWith
With mychart.Chart.Axes(xlCategory)
.MinimumScale =0' 定义X坐标轴最小值
.MaximumScale =200' 定义X坐标轴最大值
.MinorUnit =10' 定义次刻度线单位
.MajorUnit =50' 定义主刻度线单位
.CrossesAt =0'X 轴交汇点设为0
.MajorTickMark =xlInside' 主刻度线方向朝内
.MinorTickMark =xlInside' 次刻度线方向朝内
.HasMajorGridlines =False' 是否显示主网格线
.HasMinorGridlines =False' 是否显示次网格线
EndWith
Withmychart.Chart.Axes(xlValue)
.MinimumScale =0' 定义y坐标轴最小值
.MaximumScale =200' 定义y坐标轴最大值
.MinorUnit =10' 定义次刻度线单位
.MajorUnit =50' 定义主刻度线单位
.CrossesAt =0'Y 轴交汇点设为0
.MajorTickMark =xlInside' 主刻度线方向朝内
.MinorTickMark =xlInside' 次刻度线方向朝内
.HasMajorGridlines =False' 是否显示主网格线
.HasMinorGridlines =False' 是否显示次网格线
EndWith
Set mychart=Nothing' 删除图表对象变量
Application.ScreenUpdating =True' 恢复屏幕刷新 End Sub
2）根据工作表一的 A1：B10数据生成柱状图嵌入表一，位置为数据右下角位置。
SubPic2()On Error Resume Next
Application.ScreenUpdating = False
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceDat aSource:=Sheets("Sheet1").Range("A1:B10"),PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject,Name:="Sheet1"
ActiveSheet.Shapes(ActiveSheet.Shapes.C ount).Left =ActiveSheet.Cells(11,3).Left'定位于单元格
(10,2)右下角
ActiveSheet.Shapes(ActiveSheet.Shape s.Count).Top =ActiveSheet.Cells(11, 3).Top
Application.ScreenUpdating = True EndSub
第三章 Excel VBA高级使用
通过以上章节的学习，估计大家都够能使用 Excel VBA进行基本的数据计算、数据汇总、数据的保存、数据库的使用和绘制图表了，这些功能已经可以解决我们平时所遇到的大多数问题。但有时还会遇到一些较难的问题，如计算机硬件或底层方面的使用。这些问题可以使用本章介绍的WindowsAPI来解决。
Windows API是Windows的 32位应用程序编程接口，是一系列复杂函数、消息和结构的集合。这种
集合被包含在一个后缀名为 DLL的动态连接库文件中，装有Windows系统的电脑都有标准的Windows动态连接库文件。编程人员可用不同编程语言的引用方法来使用它们，进而编制出解决 Windows系统底层问 题的应用程序。ExcelVBA中使用 API可以让我们轻松实现一些高级功能，比如多媒体播放等，所以有必 要了解一些 API在 ExcelVBA中的使用。一般来讲，只有会了Windows API才算真正进入了Windows系统下程序开发的大门。
第一节 Win API的使用
Windows API是英文Application Programming Interface的缩写，Win32 API也就是微软Windows 32位操作系统的应用程序编程接口。我们可以认为 API函数是构筑整个Windows框架的基石，在它的下面是Windows的操作系统核心，而它上面则是Windows的应用程序。在 Excel VBA中使用 API就是为了开发出实用高效的应用程序，而 VBA下使用API函数需进行API函数的堀明才能使用。 一、堀明API函数堀明 VBA所在文件之外的过程或函数就能够访问 Windows API或其它外部动态连接库（ DLL）。在堀明了过程或函数后，其调用方法与 VBA自己的过程或函数调用方法相同。要堀明一个 DLL文件中的过程
或函数，需要在代码窗口增加一个Declare语句。例如取的计算机名礀的函数 GetComputerName ，作如下堀明：
Private Declare Function GetComputerName Lib "kernel 32" Alias"GetComputerNameA" (ByVal lpBuffer As
String, nSize As Long) As Long或 Public Declare Function GetComputerName Lib"kernel 32" Alias "GetComputerNameA" (ByVal lpBufferAs
String, nSize As Long) As Long
以上堀明的不同在于所堀明函数的使用范围， Private Declare堀明的是模块私有，只能在堀明它的模 块内调用； PublicDeclare堀明的是全局函数，可以在应用程序的任何地方调用，一般我们使用 Public Declare堀明。堀明完毕后就能在程序中使用此函数。
二、使用 API函数或过程
以 API函数Beep来说明 API函数的几种使用方法， Beep函数的介绍如下： 【VBA堀明】 Public Declare Function Beep Lib"kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDurationAs
Long) As Long【说明】用于生成简单的堀音【返回值】Long，非零表示成功，否则返回零。【参数表】 dwFreq--------- Long，堀音频率（从37Hz到32767Hz）。dwDuration ----- Long，堀音的持续时间，以毫秒为单位。如为-1，表示一直播放堀音，直到再次调用 该函数为止。
可采用以下几种方式使用API函数或过程，以Beep为例：（1）忽略函数返回值的调用：Beep 1000, 5000
注意此时函数的参数是不加括号的。
（2）Call方法调用：Call Beep(1000, 5000)
注意这里需要加上括号，但我们不取回函数的返回值。
（3）取得函数返回值的调用：MyLng = Beep(1000, 5000)
此时需要加上括号，而且我们必须事先定义一个变量（变量的类型与函数返回值类型相同）来存储
API函数的返回值。
三、堀明的一些说明
（1）堀明中的 Lib 和 Alias是怎么回事一般情况下Win32 API函数总是包含在Windows系统自带的或是其它公司提供的动态连接库 DLL中， 而Declare语句中的关键字Lib就是用来指定 DLL（动态连接库）文件路径是系统库路径的，这样 VBA才 能找到这个DLL文件，然后才能使用其中的API函数。如果我们只是列出 DLL文件名而不指出其完整路径的话， VBA会自动到 Excel文件所在目录、当前工作目录、Windows/System目录、Windows目录下搜寻这个 DLL文件。所以如果所要使用的 DLL文件不在
上輀几个目录下的话，我们应该指明其完整路径。
Alias用于指定 API函数的别名，如果我们调用的API函数要使用字符串（参数中包含 String型）的话， Alias关键字是必须的。这是因为在 ANSI和Unicode字符集中同一API函数的名礀可能不一样，为了保证 不出现堀明错误，所以我们使用Alias关键字指出API函数的别名。
（2）常见API参数类型的说明
API函数的参数中最常见的是长整型数据（Long）类型，例如 API中的句柄、一些特定的常量、函数 的返回值都是此类型的值；另外几种常见的参数类型有：整型Integer、Byte型、String型等。
（3）堀明中的 ByVal是作什么用的
这跟 VBA的参数传递方式有关，在默认情况下VBA是通过传值方式传递函数的参数、而有些 API函数要求必须采用地址传递方式（ByRef）来传递函数参数（这两种参数传递方式是不同的，前者传递的是参数真实的值，而后者要求是一个地址指针）。堀明中的 ByVal表明参数是传递一个值。
（4）怎样轻松得到完整API函数堀明
Visual Basic 6.0 自带 API文本查看器API Text Viewer，我们可以使用它来找到 API函数的完整堀明，然后把它粘贴到程序就可使用。如果未安装VB6，大家可以到网上下载，此外网络上还有很多 API函数的介绍，大家也可以下载来学习。大家使用 API有必要对它进行有一定了解，然后再去使用 API文本查看器。虽然不必刻意研究每个 API 函数（如果真的知道 100来个API函数的使用，相信绝对有用），但是需要我们了解一下该函数的作用。 而对API函数功能的介绍，网络也有现成的软件供大家下载使用。
四、示例
（1）弹出一个对话框，提示计算机的名礀，并且扬堀器喇叭会鸣叫。
Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long,ByVal dwDuration As Long) As
Long
Private Const MAX_COMPUTERNAME_LENGTH As Long =31
Private Declare Function GetComputerName Lib "kernel32" Alias"GetComputerNameA" (ByVal lpBuffer
As String, nSize As Long) As Long
SubComputerName()Dim dwLen As Long
DimstrString As String
'创建缓冲区32位
dwLen =MAX_COMPUTERNAME_LENGTH 1
strString =String(dwLen, "X")
'获得计算机名礀
GetComputerName strString, dwLen
'获得实际名礀字串
strString =Left(strString, dwLen)
'播放频率为4500赫兹的扬堀器堀音，持续 100微秒
For I = 0 To5
Beep 4500, 100
DoEvents
Next
'显示计算机名礀
MsgBox "电脑名礀是 " & strString& ", 我搞对了吗？ " EndSub
（2） API函数ShellExecute的使用，打开网页和发送邮件。API函数 ShellExecute的介绍： 【VBA堀明】
Private Declare Function ShellExecute Lib "shell32.dll" Alias"ShellExecuteA" (ByVal hwnd As Long,
ByVal lpOperation As String, ByVal lpFile As String, ByVallpParameters As String, ByVal lpDirectoryAs
String, ByVal nShowCmd As Long) As Long【别名】ShellExecuteA【说明】查找与指定文件关联在一起的程序的文件名【返回值】Long，非零表示成功，零表示失败。【参数表】 hwnd-----------Long，指定一个窗口的句柄，有时候，windows程序有必要在创建自己的主窗口前显示一个消息框lpOperation ---- String，指定字串“ open”来打开lpFlie文档，或指定“Print”来打印它lpFile ---------String，想用关联程序打印或打开一个程序名或文件名lpParameters --- String，如lpszFlie是可执行文件，则这个字串包含传递给执行程序的参数lpDirectory ----String，想使用的完整路径nShowCmd -------Long，定义了如何显示启动程序的常数值。参考ShowWindow函数的 nCmdShow 参数示例代码：
Private Declare Function ShellExecute Lib "shell32.dll" Alias"ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String,ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectoryAs String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
Private SubCommandButton1_Click()Unload Me End Sub
Private SubLabel4_Click()'启动邮件程序
ShellExecute 0, "Open", "mailto:zhoujibin123@1126.com", "", "", SW_SHOWNORMAL
UnloadMe End Sub
Private Sub Label5_Click()
'启动网络程序,连接到Excelhome论坛的帖子上 ShellExecute 0,"Open",_ "http://club.excelhome.net/dispbbs.asp?boardid=2&replyid=462739&id=178278&page=1&skin=0&Star=1","", "", SW_SHOWNORMAL
Unload Me End Sub
第二节 Excel VBA程序的保密
Excel VBA 程序的保密是个难点，大家对此都感兴趣，原因是想保护核心代码和技术以及对商业的
Excel VBA 程序进行安全保障。Excel 对 VBA工程加密仅起简单保护作用，稍懂一点的程序员就可手工 破解或使用网上的破解软件。目前唯一能保障VBA 代码就一个方法，把 VBA 核心代码封装到动态连接 库（DLL）文件中。大家可以放心动态连接库，因为它是很难被反编译的（反编译的代价比开发还大） 、非常安全。下面就开始介绍如何制作和使用动态连接库 DLL。
一、动态连接库 DLL的制作和使用
1）用 VB6 企业版下 ActiveX.DLL工具开发，在缺省类代码窗口输入下面代码：
Sub copy12(x As Integer, y AsInteger)' 目的是把表x单元格值赋值给表y'定义将要用到的变量数据，对象变量，整型数据变量
Dim xlapp As Object, xlbok As Object,xlsht1 AsObject,xlsht2 As Object, xlrng As Object
Dim i As Integer, j As Integer, irow1 As Integer,icol1 As Integer
Dim irow2 As Integer, icol2 As Integer, cellssumAs Integer
Set xlapp =GetObject(, "Excel.Application") '取得Excel实例
Set xlbok =xlapp.activeworkbook' 取得 Excel实例下活动工作簿
Set xlsht1 =xlbok.Worksheets(x)' 取得 Excel实例下活动工作簿的第 x表格
Set xlsht2 =xlbok.Worksheets(y)' 取得 Excel实例下活动工作簿的第 y表格
Set xlrng =xlsht1.UsedRange' 取得 Excel实例下活动工作簿的第x表格的已用区域
cellssum =xlrng.Count'x 表格的已用区域的单元格数目
irow1 =xlrng.cells(1).row' 已用区域的第1单元格的行
icol1 =xlrng.cells(1).Column' 已用区域的第1单元格的列
irow2 =xlrng.cells(cellssum).row' 已用区域的最后单元格的行
icol2 =xlrng.cells(cellssum).Column' 已用区域的最后单元格的列
For i =irow1 Toirow2' 从已用区域第1行到最后一行循环
For j = icol1 Toicol2' 从已用区域第1列到最后一列循环
xlsht2.cells(i, j) = xlsht1.cells(i,j)' 把x表已用区域单元格数据赋值给y表相同位置
Next' 此处目的可用别方法实现，或加判断实现别的
Next
Set xlapp =Nothing' 清除定义的对象为空
Set xlbok =Nothing
Set xlsht1 =Nothing
Set xlsht2 =Nothing
Set xlrng =Nothing End Sub
Function Getstrgs(STRG As String, FC As String, LC As String) AsVariant'求字符间各子串赋值给数组Dim ss() AsStringOn Error Resume Next
Sum = 0
For i = 1 To Len(STRG) -1
If Mid(STRG, i, 1) = FC Then
For j = i 1 To Len(STRG)
If Mid(STRG, j, 1) = LC Then Sum = Sum 1
Next
End If
Next
If Sum< 1 Then
MsgBox "No substring found!"
Exit Function
EndIf
ReDim ss(Sum- 1) As String
Sum =0
For i = 1 To Len(STRG) -1
If Mid(STRG, i, 1) = FC Then
For j = i 1 To Len(STRG)
If Mid(STRG, j, 1) = LC Then
ss(Sum) = Mid(STRG, i 1, j - i - 1)
Sum = Sum 1
End If
Next
End If
Next
Getstrgs =ss End Function
以上代码仅展示类中的过程和函数，以便在 VBA中使用。
2）修改将要引用的类名礀，在 VB6的类属性窗口修改，本例修改为mycopy1to2
3）工程保存，本例保存为 sheetcopy1to2
4）DLL生成，本例保存为sheetcopy1to2.dll2-4步骤对大家来说，不应该存在问题的。
二． VBA中调用 DLL
1） VBE窗口下，点工具菜单-引用，在点弹出窗口的浏览按钮，找到你的 DLL文件，最好和 EXCEL
文件放一个目录下，便于下一步骤。
2） DLL的注册，如下：
Private Sub Workbook_BeforeClose(Cancel AsBoolean)
Shell "Regsvr32 /u /s " & Chr(34)& ThisWorkbook.Path &"/sheetcopy1to2.dll" &Chr(34)
End Sub
Private Sub Workbook_Open()
'一定要先引用 dll，才可以自动注册."Regsvr32/s " 中/s是表示不出现对话框
On Error GoToerrline
Shell "Regsvr32 /s " & Chr(34)& ThisWo rkbook.Path &"/sheetcopy1to2.dll" &Chr(34)
Exit Suberrline:MsgBox "程序在注册DLL函数时出现错误！ " EndSub
也可以在Windows 开始菜单下的运行命令对话框中运行 Regsvr32 "DLL全路径/文件名 .dll" 来注册
DLL文件
3） VBA中使用 DLL的过程和函数，代码示例如下VBE下新建如下模块：
Sub mycopy1to2()
Dim bb As Newmycopy1to2' 定义 bb为 DLL中的类mycopy1to2bb.copy12 1,2' 表格1内容到表格2，使用类mycopy1to2新实例 bb的过程
Set bb = Nothing EndSub
Sub mycopy2to3()
Dim bb As Newmycopy1to2 bb.copy12 2,3' 表格2内容到表格 3
Set bb = Nothing EndSub
Sub mycopy3to1()
Dim bb As Newmycopy1to2 bb.copy12 3,1
Set bb = Nothing EndSub
Sub string1()
Dim aa As Variant
Dim bb As Newmycopy1to2' 定义 bb为 DLL中类 mycopy1to2 新实例aa = bb.Getstrgs(Cells(1, 1), Cells(1, 2), Cells(1,3))'使用类mycopy1to2新实例 bb的函数
For i = 0 ToUBound(aa)'用 DLL中类的函数求字符串的各子串
Cells(i 2, 1) = aa(i)
Next
Set bb = Nothing EndSub
代码能理解多少就多少，这是次要的，主要是学会如何轻松使用 DLL保护自己的 VBA代码。学到这，
相信大家应该已经会制作 DLL文件和在 VBA中使用它了。
2) 获得硬盘物理地址
为什么要获得物理地址，那是因为电脑上唯一不变的就是硬盘物理地址号码。比如网卡的物理地址，大家都会改动。因此获得该硬盘物理地址号码用来加密和注册，便显得非常之重要。其获得地址的代码如示例，由于其较长，所以这里就省略。实际使用时，把该代码和注册加密的代码封装到DLL库中使用。
3) 加密与注册
对正版软件的注册，有效的方法是一机一码，即一匀电脑一个注册码。即使别人获得了注册码和软
件，在别的机子上也无法使用。这一机一码就是基于电脑硬盘的唯一物理地址。打个比方来理解这个方法： 电脑上的硬盘物理地址为DISK_ID，经过钥匙串 KEY1加密得到User_ID；软件开发人员然后根据钥匙串 KEY1解密User_ID获得用户的DISK_ID，再经钥匙串 KEY2加密获得所谓的注册号Reg_ID；用户输入
Reg_ID并存在电脑注册表或文件上，软件启动后，调用注册核对功能，通过 KEY2加密 DISK_ID获得一 字符串，与REG_ID对比，看是否一致，不一致则提示未注册并关闭程序运行。这里的KEY1和 KEY2及 加密解密算法，都存放在DLL中，核心程序也存放在该DLL中，所以该方法注册可以保证一机一码且安全。下面就介绍多种字符串加密解密算法的一种，是我以前看啥资料想到后设计出的。
基础原理如下：
A. 可见字符的ASC码：0-9的 Asc码为 48-57；大写A-Z的 Asc码为 65-90；小写a-z 的 Asc码为97-122。
Asc码是一整数型数据，占一个字节8位长度。
B. 异或操作（对应位的数字不同则为 1，相同为0）：举个例，电脑里一个字节的二进制数： 01101110
与11000011异或结果为10101101，该结果在与11000011再异或一次，其结果是 01101110，这与开始的数相同，所以一个数对另一个数两次异或就会复原。
（1）加密步骤，PlainStr为待加密字串， KEY为钥匙字串。
第一步：取 KEY第一个字符的 Asc码和 PlainStr每一个字符的 Asc码异或，如果异或结果为可见字符的
Asc码范围，则其 Asc码对应的字符为新加密字符，否则新加密字符就是刚才的 PlainStr对应位置的字符， 各个加密字符合并就是被KEY第一个字符的 Asc码加密过的字符串，并取代 PlainStr。
第二步：循环第一步，依次用KEY的其余字符按第一步方法执行，得到最后的PlainStr。
第三步：异或操作后的 PlainStr长度为偶数，则分为左右两半，左右两字符串各自进行反序，其后合并
成一个字符串。
第四步：经过以上三步的操作， PlainStr字符串就经过钥匙字串 KEY的加密。
（2）解密步骤，PlainStr为待解密字串， KEY为钥匙字串。
第一步：PlainStr长度为偶数，则分为左右两半，左右两字符串各自进行反序，其后合并成一个新的字
符串 PlainStr。
第二步：取 KEY最后一个字符的 Asc码和 PlainStr每一个字符的 Asc码异或，如果异或结果为可见字符
的 Asc码范围，则其 Asc码对应的字符为新解密字符，否则新解密字符就是刚才的 PlainStr对应位置的字符，各个解密字符合并就是被 KEY最后一个字符的 Asc码解密过的字符串，并取代PlainStr。
第三步：循环第二步，依次用KEY的其余倒序字符按第二步方法执行，得到最后的PlainStr。
第四步：经过以上三步的操作， PlainStr字符串就经过钥匙字串 KEY的解密。
示例代码如下：
'******************************************************************************'加密解密算法 '可见字符ASC码：48-57(0-9);65-90(A-Z);97-122(a-z)'异或结果为可见字符则异或'偶数则把异或结果分成两半各自并反序，增加破解难度
'***********************************加密***************************************Private Function Encrypt(PlainStr As String, key As String) asstring
Dim Char As String, KeyChar As String, NewStr As String, AscCode AsLong
Dim i As Integer, j As Integer, Side1 As String, Side2 AsString
For j = 1 ToLen(key)'钥匙字符串正向逐个取字符，用其 Asc码和待加密字符串各字 符的 Asc码异或操作
NewStr =""
KeyChar =Mid(key, j, 1)
For i = 1 ToLen(PlainStr)' 取待加密字符串各字符
Char = Mid(PlainStr, i, 1)
AscCode = Asc(Char) XorAsc(KeyChar) ' 对字符的Asc码异或操作
If (AscCode <= 57 And AscCode>= 48) Or (AscCode <= 90 And AscCode>= 65) Or (AscCode<=
122 And AscCode >= 97) Then
NewStr = NewStr &Chr(AscCode)' 异或后的 Asc码是可见字符的 Asc码，则把异或结
果转成字符，加入异或结果字符串
Else
NewStr = NewStr &Char' 异或后的 Asc码是不可见字符的 Asc码，则把原先
字符加入异或结果字符串
End If
Nexti
PlainStr =NewStr Next j
If Len(PlainStr) Mod 2 = 0Then' 异或结果字符串，其长度为偶数则分左右两半并各自反
序
Side1 = StrReverse(Left(PlainStr, (Len(PlainStr)/ 2)))
Side2 = StrReverse(Right(PlainStr, (Len(PlainStr)/ 2)))
PlainStr =Side1 &Side2' 合并左右反序字符串 End If
Encrypt =PlainStr' 生成加密结果字符串
End Function
'***********************************解密***************************************Private Function Decrypt(PlainStr As String, key As String) asstring
Dim Char As String, KeyChar As String, NewStr As String, AscCode AsLong
Dim i As Integer, j As Integer, Side1 As String, Side2 AsString
If Len(PlainStr) Mod 2 = 0Then' 字符串为偶数长度，则分左右两半并各自反序
Side1 = StrReverse(Left(PlainStr, (Len(PlainStr)/ 2)))
Side2 = StrReverse(Right(PlainStr, (Len(PlainStr)/ 2)))
PlainStr =Side1 &Side2' 合并左右反序后字符串 End If
For j = Len(key) To 1 Step-1'反顺序逐个取钥匙字符串各字符，用其 Asc码和待解密 字符串各字符的Asc码异或操作
NewStr =""
KeyChar =Mid(key, j,1)
For i = 1 ToLen(PlainStr)' 对字符串每个字符的 Asc码进行异或
Char = Mid(PlainStr, i, 1)
AscCode = Asc(Char) XorAsc(KeyChar) ' 字符的Asc码进行异或
If (AscCode <= 57 And AscCode>= 48) Or (AscCode <= 90 And AscCode>= 65) Or (AscCode<=
122 And AscCode >= 97) Then
NewStr = NewStr &Chr(AscCode)' 异或后的 Asc码是可见字符的 Asc码，则把异或结
果转成字符，加入异或结果字符串
Else
NewStr = NewStr &Char' 异或后的 Asc码是不可见字符的 Asc码，则把原先
字符加入异或结果字符串
End If
Nexti
PlainStr =NewStr Next j
Decrypt = PlainStr
End Function
第四章 Excel VBA优化及结束语
第一节 Excel VBA优化
由于 Microsoft Office办公套件的广泛应用，以及该软件版本的不断提升，功能不断完善，在 Office办公套件平匀上开发出的的 VBA应用程序越来越多，而 VBA是一种宏语言，在运行速度上有很大的限制。 因此VBA编程的方法直接关系到VBA程序运行的效率，本节列举了一些提高VBA程序运行效率的方法。
方法1：尽量使用VBA原有的属性、方法和Worksheet函数
由于 Excel对象多达百多个，对象的属性、方法、事件多不胜数，对于初学者来说可能对它们不全部
了解，这就产生了编程者经常编写与 Excel对象的属性、方法相同功能的 VBA代码段，而这些代码段的运行效率显然与Excel对象的属性、方法完成任务的速度相差甚大。例如用 Range的属性 CurrentRegion来返 回Range对象，该对象代表当前区。（当前区指以任意空白行及空白列的组合为边界的区域）。同样功能的 VBA代码需数十行。因此编程前应尽可能多地了解Excel对象的属性、方法。
充分利用Worksheet函数是提高程序运行速度的极度有效的方法。如求平均工资的例子：For Each c InWorksheet(1).Range(″A1:A1000″)
TotalV alue =TotalV alue＋c.Value
Next
AverageValue = TotalValue /Worksheet(1).Range(″A1:A1000″).Rows.Count
而下面代码程序比上面例子快得多：
AverageValue=Application.WorksheetFunction.Average(Worksheets(1).Range(″A1:A1000″))
其它函数如 Count,Counta,Countif,Match,Lookup等等，都能代替相同功能的VBA程序代码，提高程序
的运行速度。
方法2：尽量减少使用对象引用，尤其在循环中
每一个 Excel对象的属性、方法的调用都需要通过 OLE接口的一个或多个调用，这些OLE调用都是
需要时间的，减少使用对象引用能加快VBA代码的运行。例如
1)．使用With语句。
Workbooks(1).Sheets(1).Range(″A1:A1000″).Font.Name=″Pay″
Workbooks(1).Sheets(1).Range(″A1:A1000″).Font.FontStyle=″Bold″... 则以下语句比上面的快
WithWorkbooks(1).Sheets(1).Range(″A1:A1000″).Font
.Name =″Pay″
.FontStyle =″Bold″
...
EndWith
2)．使用对象变量。
如果你发现一个对象引用被多次使用，则你可以将此对象用 Set 设置为对象变量，以减少对对象
的访问。如：
Workbooks(1).Sheets(1).Range(″A1″).Value= 100
Workbooks(1).Sheets(1).Range(″A2″).Value= 200
则以下代码比上面的要快：
Set MySheet =Workbooks(1).Sheets(1)
MySheet.Range(″A1″).Value =100
MySheet.Range(″A2″).Value =200
3)．在循环中要尽量减少对象的访问。For k = 1 To 1000
Sheets(″Sheet1″).Select
Cells(k,1).Value = Cells(1,1).Value
Next k
则以下代码比上面的要快：
Set TheValue =Cells(1,1).Value
Sheets(″Sheet1″).Select
For k = 1 To1000
Cells(k,1).Value = TheValue
Nextk
方法3：减少对象的激活和选择
如果你的通过录制宏来学习 VBA的，则你的 VBA程序里一定充满了对象的激活和选择，例如
Workbooks(XXX).Activate、 Sheets(XXX).Select、Range(XXX).Select等,但事实上大多数情况下这些操作不是必需的。例如
Sheets(″Sheet3″).Select
Range(″A1″).Value =100
Range(″A2″).Value =200
可改为： WithSheets(″Sheet3″)
.Range(″A1″).Value =100
.Range(″A2″).Value =200
EndWith
方法4：关闭屏幕更新
如果你的 VBA程序前面三条做得比较差，则关闭屏幕更新是提高 VBA程序运行速度的最有效的方法，
缩短运行时间2/3左右。关闭屏幕更新的方法：
Application.ScreenUpdate =False
请不要忘记 VBA程序运行结束时再将该值设回来：
Application.ScreenU pdate =Tr ue
方法5：变量类型确定,少用变体变量
Option Explicit 语句, 在模块级别中使用，强制显式堀明模块中的所有变量。如果模块中使用了
Option Explicit，则必须使用 Dim、 Private、 Public、 ReDim或 Static 语句来显式堀明所有的变量。如果使用了未堀明的变量名在编译时间会出现错误。如果没有使用 Option Explicit语句，一般所有未堀明的变 量都是 Variant 类型的。
注意 使用 Option Explicit可以避免在键入已有变量时出错，在变量的范围不是很清楚的代码中使用
该语句可以避免混乱 .
方法6：关闭Excel系统提示
'本示例关闭所有打开的工作簿。如果某个打开的工作簿有改变， Microsoft Excel 将显示询问是否保存
更改的对话框和相应提示。
Workbooks.Close实际开发程序时,需要关闭提示信息对话框,给用户简洁高效的体验.
Application.DisplayAlerts =False '信息警告关闭请不要忘记VBA程序运行结束时再将该值设回来：Application.DisplayA lerts =Tr ue '信息警告开启
关闭信息警告后, 保存文档及关闭需要先保存,在关闭Workbooks("filename.xls").Save'文件保存
Workbooks("filename.xls").CloseSaveChanges:=True'文件关闭,不出现是否要保存的窗口,并保存所有对此工作簿的更改。Workbooks("BOOK1.XLS").CloseSaveChanges:=False'本示例关闭Book1.xls，并放弃所有对此工作簿的更改。这样可以提高程序的简洁性,给用户服务.
方法7: 提高关键代码和循环代码的效率
不同方法执行效率的差异，但千万不要因为追求效率而损失了代码的可读性、清晰性。效率的优化必
须是针对关键代码的优化，对于一些在程序执行过程中，只执行很少次数的代码，没有必要牺牲可读性而进行优化。对于代码执行效率，千万不要人云亦云，必要时候，自己动手测试一下，结果往往会出 乎意料。
代码执行时间的测算VBA和 VB中，没有专门的代码执行事件测算工具和方法，笔者一般是使用 Timer
函数，其返回值是一个 Single类型的数值，代表从午夜开始到现在经过的秒数，此数值包括小数部分，但 精确程度在WindowsNT，2000和 XP下大概接近 10毫秒。如果要测试一段代码的执行速度，可以使用如下方法：
Sub MeasureTime()
Dim Time1 As Single, Time2 As Single
Dim TotalTime As Single
Dim Times As Long
Dim i As Long
Times = 10000
Time1 = Timer
For i = 1 To Times Step 1
Mytest1
Next i
Time2 = Timer
TotalTime = (Time2 - Time1) * 1000
MsgBox "执行时间: " & TotalTime & "毫秒（次数： " _
& Times &")"
End Sub
SubMytest1()Dim i As Long
Dim s As String
i = Rnd
s = Format(i, "#.00")
End Sub
过程 MeasureTime可以测试一个过程的执行速度，因为一般一个过程执行会很快，所以使 用循环， 执行n次（第8行设置），在第12行调用测试的过程，通过循环前的时间（第9行）和 循环后的时间（第15行），计算总共执行时间（第17行）。使用这个方法，就可以做一些测试，看哪些方法执行效率更高。另外，由于Windows的多任务特定，测试时最好关闭其他无关程序，以获得较准确的测试结果。
方法8 注意单元格写法
cells(1,1)>>>>>range("a1")>>>>.[a1]cells(1,1)符合 EXCEL结构，最快range("a1")有对象，稍稍慢 [A1]写的快，运行慢
方法9 不要直呼其名
a= Worksheets(1).Name>>>>>a=Worksheets("Sheet1").name
方法10 少用 RANGE对象，可用数组取代，速度快 5-10倍， Test2就比Test1快。
SubTest1()
Dim i As Long, j As Long, buf As Long
For i = 1 To10000
For j = 1 To100
buf = Cells(i, j)
N ext j
Next i
End Sub
SubTest2()
Dim i As Long, j As Long, buf As Long, C AsVariant
C =Range("A1:CV10000")
For i = 1 To10000
For j = 1 To100
buf = C(i, j)
N ext j
Next i
End Sub
方法11 注意函数的类型 , 尽量少用Variant变量，多用整型变量，如多用整型变量函数。
Chr$ ChrB$Command$
CurDir$ Date$Dir$
Error$ Format$Hex$
Input$ InputB$LCase$
LeftB$LTrim$
Mid$ MidB$Oct$
Right$ RightB$RTrim$
Space$ Str$String$
Time$ Trim$ UCase$
这些字符型函数 就比chr date space 等快，因为不加后缀类型指定的函数，其返回值是 Variant类型结
果。
第二节 结束语
经过一礼拜的疲劳（没功劳有苦劳，没苦劳总有疲劳，套一句《疯狂石头》的电影对白） ，我总算结束了开始的计划，也算是有头有尾，稍感欣慰。这期间，我要感谢各位 VBA爱好者的鼓励和支持，你们的坚持浏览让我有信心继续写下去，让我感到我写的还有点用（不是瞎写、乱写的，无乱灌水之嫌疑）。
我对程序开发，以前学过很多东西，可以说是陪着一些计算机开发语言发展走过一段时间的。记得 96
年大学时，我们学汇编语言，那时觉得像天文；觉得难，就学习 Foxbase数据库，记得考计算机二级时，我上机得了满分，一下子有信心了，就转而学习 VB5，但学来学去，就是没法突破，后来硕士期间，我学 会了VB6，解决了一个实际问题，这下对 VB6开发及程序开发，有了更深刻的理解；但还是觉得VB6没能有好的办法解决计算机复杂的问题，比如矢量图的绘制和保存，我就一直搞不会。后来东看西看，学了 很多计算机东西。读博士期间，用Excel解决数据计算和作图，由于是要重复作类似的，所以学下了 VBA， 突然发现 ExcelVBA是很适合我这种使用者—需要快速解决工作学习的实际问题， 由此我也开发了世界一流的地化数据投图软件Geoplot，关于它的论文发表在 Computers &Geosciences上。在开发这个软件期间， 学了很多东西，这些核心的东西我都在这个论坛发过贴了。所以，我隆重推荐大家学习VBA，由于它是入 门，学习，进阶都很快速，很容易上手的，是解决实际工作的最佳工具（信不信由你！）。对于其它开发语言，我认为目前的开发语言越来越一致了，都是以对象为核心，比如 VB.NET,VC .NET等，所以学会一 种VB.NET就可以解决其它开发问题，但普通用户来讲，是不需要学会和精通那些的，只要知道有它们的存在，且找一本书学一下，如果真的有机会，有事情需要用到那些，再学习。因为大家都很忙，所以建议 学习VBA这种快速解决问题的工具，看我的内容，估计一个礼拜就学会了，再看看论坛上的贴子，我想 大家一个月就能成为VBA中级人员。程序开发，其实还需要一定天赋的，因为核心的算法是要靠一定智慧的，不同的人，搞出来的，虽然都解决问题，但速度差异很大等。
想到那就写到那，胡言乱语。宗旨就是建议大家学些VBA，它是一种快速上手和能用到实际中解决问
题的工具软件。
