Excel VBA常用技巧 第09章 函数的使用

VBA常用技巧代码解析

VBA常用技巧

目录

VBA常用技巧 ................................................................................................................................... 1

第9章 函数的使用 ........................................................................................................... 2

技巧1 调用工作表函数求和 ....................................................................................... 2 技巧2 查找最大、最小值 ........................................................................................... 2 技巧3 不重复值的录入 ............................................................................................... 4 技巧4 获得当月的最后一天 ....................................................................................... 6 技巧5 四舍五入运算 ................................................................................................... 7

5-1 极小值修正法 ................................................................................................ 7 5-2 调用工作表函数法......................................................................................... 8 技巧6 使用字符串函数 ............................................................................................... 8 技巧7 使用日期函数 ................................................................................................. 10 技巧8 判断是否为数值 ............................................................................................. 14 技巧9 格式化数值、日期和时间 ............................................................................. 15 技巧10 个人所得税自定义函数 ............................................................................... 17 技巧11 人民币大写函数 ........................................................................................... 19 技巧12 列号转换为列标 ........................................................................................... 21 技巧13 判断工作表是否为空表 ............................................................................... 22 技巧14 查找指定工作表 ........................................................................................... 23 技巧15 查找指定工作簿是否打开 ........................................................................... 25 技巧16 取得应用程序的安装路径 ........................................................................... 25 技巧17 数组的使用 ................................................................................................... 27

17-1 代码运行时创建数组................................................................................. 27 17-2 文本转换为数组 ........................................................................................ 28 17-3 使用动态数组去除重复值 ......................................................................... 30

1

VBA常用技巧代码解析

第9章 函数的使用

技巧1 调用工作表函数求和

在对工作表的单元格区域进行求和计算时，使用工作表Sum函数比使用VBA代码遍历单元格进行累加求和效率要高得多，代码如下所示。

#001 Sub rngSum()

#002 Dim rng As Range #003 Dim d As Double

#004 Set rng = Range(\

#005 d = Application.WorksheetFunction.Sum(rng) #006 MsgBox rng.Address(0, 0) & \单元格的和为\#007 End Sub

代码解析：

rngSum过程调用工作表Sum函数对工作表的单元格区域进行求和计算。

在VBA中调用工作表函数需要在工作表函数前加上WorksheetFunction属性。应用于Application对象的WorksheetFunction属性返回WorksheetFunction对象，作为VBA中调用工作表函数的容器，在实际应用中可省略Application对象识别符。

技巧2 查找最大、最小值

在VBA中没有内置的函数可以进行最大、最小值的查找，借助工作表Max、Min函数可以快速地在工作表区域中查找最大、最小值，如下面的代码所示。

#001 Sub seeks()

2

VBA常用技巧代码解析

#002 Dim rng As Range #003 Dim myRng As Range

#004 Dim k1 As Integer, k2 As Integer #005 Dim max As Double, min As Double #006 Set myRng = Sheet1.Range(\#007 For Each rng In myRng

#008 If rng.Value = WorksheetFunction.max(myRng) Then #009 rng.Interior.ColorIndex = 3 #010 k1 = k1 + 1 #011 max = rng.Value

#012 ElseIf rng.Value = WorksheetFunction.min(myRng) Then #013 rng.Interior.ColorIndex = 5 #014 k2 = k2 + 1 #015 min = rng.Value #016 Else

#017 rng.Interior.ColorIndex = 0 #018 End If #019 Next

#020 MsgBox \最大值是:\共有 \个\#021 & Chr(13) & \最小值是:\共有 \个\#022 End Sub

代码解析：

seeks过程在工作表单元格区域中查找最大、最小值，并将其所在的单元格底色分别设置为红色和蓝色。

第2行到第5行代码声明变量类型。

第6行代码使用关键字Set将单元格引用赋给变量myRng。

第7行到第19行代码遍历单元格区域，使用工作表Max、Min函数判断单元格数值是否是所在区域的最大、最小值，如果是，将其所在的单元格底色设置为红色或蓝色，并保存其数值和数量。

第20、21行代码使用消息框显示最大、最小值数值和数量。

运行seeks过程后将工作表区域最大、最小值所在的单元格的底色设置为红色或蓝色并用消息框显示其数值和数量，如图 2-1所示。

3

VBA常用技巧代码解析

图 2-1 查找最大、最小值

技巧3 不重复值的录入

在工作表中录入数据时，有时希望能限制重复值的录入，比如在示例的A列单元格只能录入唯一的人员编号，此时可以利用工作表的Change事件结合工作表的CountIf 函数来判断所录入的人员编号是否重复，示例代码如下。

#001 Private Sub Worksheet_Change(ByVal Target As Range) #002 With Target

#003 If .Column <> 1 Or .Count > 1 Then Exit Sub

#004 If Application.CountIf(Range(\#005 .Select

#006 MsgBox \不能输入重复的人员编号!\#007 Application.EnableEvents = False #008 .Value = \

#009 Application.EnableEvents = True

4

VBA常用技巧代码解析

#010 End If #011 End With #012 End Sub

代码解析：

工作表的Change事件过程，使A列单元格只能录入唯一的人员编号。

第4行代码使用工作表的CountIf 函数来判断在A列单元格输入的人员编号是否重复。工作表的CountIf 函数计算区域中满足给定条件的单元格的个数，语法如下：

COUNTIF(range, criteria)

参数range为需要计算其中满足条件的单元格数目的单元格区域。

参数criteria为确定哪些单元格将被计算在内的条件，其形式可以为数字、表达式、单元格引用或文本。

在示例中以所录入的人员编号与A列单元格区域进行比较，如果CountIf 函数的返回值大于1，说明录入的是重复编号。

第5行代码，重新选择该单元格便于下一步清空后重新录入。

第7、8、9行代码，清除录入的重复编号，在清除前将Application对象的EnableEvents属性设置为False，禁用事件。因为如果不禁用事件，那么在清除重复值的过程中会不断地触发工作表的Change事件，从而造成代码运行的死循环。

经过以上的设置，在工作表的A列中只能录入唯一的人员编号，如果录入重复值会进行提示，如图 3-1所示，点击确定后自动清除录入的重复编号。

图 3-1 限制重复值的录入

5

VBA常用技巧代码解析

技巧4 获得当月的最后一天

在实际工作中经常需要根据给定的日期计算其所属月份的最后一天，此时可以使用DateSerial函数完成计算，如下面的代码所示。

#001 Sub Serial()

#002 Dim DateStr As Byte

#003 DateStr = Day(DateSerial(Year(Date), Month(Date) + 1, 0)) #004 MsgBox \本月的最后一天是\月\号\#005 End Sub

代码解析：

Serial过程配合使用了4个VBA内置函数Year、Month、Day和DateSerial完成计算并使用消息框显示当月最后一天的日期。

Year、Month和Day函数分别返回代表指定日期的年、月、日的整数，语法如下：

Year(Date) Month(Date) Day(Date)

其中参数Date可以是任何能够表示日期的Variant、数值表达式、字符串表达式或它们的组合。

DateSerial函数返回包含指定的年、月、日的Variant (Date)，语法如下：

DateSerial(year, month, day)

其中参数year、 month、day分别表示指定的年、月、日。

为了指定某个日期， DateSerial 函数中的每个参数的取值范围应该是可接受的，即日的取值范围应在1-31之间，而月的取值范围应在1-12之间。但是，当一个数值表达式表示某日之前或其后的年、月、日数时，也可以为每个使用这个数值表达式的参数指定相对日期。当任何一个参数的取值超出可接受的范围时，它会自动地在可接受的时间单位进行调整，例如本例中的day参数设置为0，则被解释成month参数指定月的前一天，即表达式Month(Date) + 1指定的下一个月的前一天，也就是本月的最后一天。

运行Serial过程结果如图 4-1所示。

图 4-1 获得当月的最后一天

6

VBA常用技巧代码解析

技巧5 四舍五入运算

在实际工作中经常需要对数值或计算结果进行四舍五入运算，此时可以使用VBA内置的Round函数。Round函数返回一个数值，该数值是按照指定的小数位数进行四舍五入运算的结果，语法如下：

Round(expression [,numdecimalplaces])

参数expression是必需的，要进行四舍五入运算的数值表达式。

参数numdecimalplaces是可选的，数字值，表示进行四舍五入运算时，小数点右边应保留的位数。如果忽略，则Round函数返回整数。

但是VBA内置的Round函数在对数值进行四舍五入运算时实行的是Bankre舍入，而不是算术舍入。按Bankre舍入规则，如果保留位数的下一个数字正好是5则其后没有其他有效数字，则按保留位最后一位“偶舍奇入”的方法进行处理。比如Round(1.5)的保留位最后为1，是奇数，小数位的5入上去，因此Round(1.5)的运算结果是2；而Round(4.5)的保留位最后为4，是偶数，小数位的5舍去，因此Round(4.5) 的运算结果是4而不是5。

Bankre舍入规则虽然有其合理性，但不符合实际工作的需要。在实际应用中使用以下两种方法避免Bankre舍入：

5-1 极小值修正法

在使用Round函数时对需要舍入的数值先加上极小值再调用VBA内置的Round函数，如下面的代码所示。

#001 Sub aTestRound()

#002 MsgBox \& Round(4.5) & Chr(13) & \& Round(4.5 + 0.0000001)

#003 End Sub

代码解析：

aTestRound过程分别调用VBA内置的Round函数和加上极小值再调用VBA内置的Round函数在洗染店框中显示两者运算结果，如图 5-1所示。

图 5-1 加上极小值进行运算结果

7

VBA常用技巧代码解析

从运算结果中可以发现，加上极小值后Round(4.5)已正确运算为5而不是4。

5-2 调用工作表函数法

还可以使用工作表函数Round代替VBA内置的Round函数。工作表函数Round和VBA内置的Round函数的用法相同，但它采用算术舍入而不是Bankre舍入，所以不会有“偶舍奇入”的问题，如下面的代码所示。

#001 Sub bTestRound()

#002 MsgBox \& Round(4.5) & Chr(13) & \& Application.Round(4.5, 0)

#003 End Sub

代码解析：

bTestRound过程分别调用VBA内置的Round函数和工作表Round函数在消息框中显示两者运算结果，如图 5-2所示。

图 5-2 工作表函数运算结果

从运算结果中可以发现，使用工作表Round函数后Round(4.5)已正确运算为5而不是4。

技巧6 使用字符串函数

使用VBA的字符串函数可以对字符串进行各种操作，如下面的代码所示。

#001 Sub StrFunctions() #002 Dim Str As String

#003 Str = \

#004 MsgBox \原始字符串为：\

8

VBA常用技巧代码解析

#005 & \字符串长度为：\#006 & \左边8个字符为：\#007 & \右边6个字符为：\

#008 & \从左边第2个开始取5个字符为：\#009 & \转换为大写：\#010 & \转换为小写：\#011 End Sub

代码解析：

StrFunctions过程使用字符串函数对字符串进行各种操作，如计算字符数、取得一定数量的字符、大小写转换等。

第5行代码使用Len函数返回字符串内字符的数目，Len函数语法如下：

Len(string | varname)

参数string为任何有效的字符串表达式。 参数varname为任何有效的变量名称。

两个可能的参数必须有一个，而且只能有一个参数。 第6行代码使用Left函数从字符串左边起返回8个字符。 第7行代码使用Right函数从字符串右边起返回6个字符 Left函数语法如下：

Left(string, length)

Right函数语法如下：

Right(string, length)

参数string是必需的，字符串表达式。

参数length是必需的，数值表达式，将返回的字符数量。如果为0，返回零长度字符串 (\；如果大于或等于参数string的字符数，则返回整个字符串。

第8行代码使用Mid函数从字符串第2位起返回5个字符。Mid函数语法如下：

Mid(string, start[, length])

参数string是必需的，字符串表达式。

参数start是必需的，string中被取出部分的字符位置。如果超过string的字符数，将返回零长度字符串 (\。

参数length是可选的，要返回的字符数。如果省略或超过string的字符数，将返回字符串中所有字符。

第9行代码使用UCase函数将字符串转换成大写的字符串。

9

VBA常用技巧代码解析

第10行代码使用LCase函数将字符串转换成小写的字符串。 UCase函数的语法如下：

UCase(string)

LCase函数的语法如下：

LCase(string)

参数string是必需的，任何有效的字符串表达式。 运行StrFunctions过程结果如图 6-1所示。

图 6-1 使用字符串函数

技巧7 使用日期函数

使用VBA的日期函数可以对日期进行各种计算，如下面的代码所示。

#001 Sub DatFunctions() #002 Dim Str As String #003 Dim Week As String

#004 Str = InputBox(\请输入日期：\#005 If Len(Str) > 0 Then #006 If IsDate(Str) Then

#007 Select Case Weekday(Str, vbMonday) #008 Case 1

#009 Week = \一\

10

VBA常用技巧代码解析

#010 Case 2

#011 Week = \二\#012 Case 3

#013 Week = \三\#014 Case 4

#015 Week = \四\#016 Case 5

#017 Week = \五\#018 Case 6

#019 Week = \六\#020 Case 7

#021 Week = \日\#022 End Select

#023 MsgBox \你输入的日期是\

#024 & \是\年的第\季度\

#025 & \是星期\

#026 & \距离今天有\天\Chr(13) _

#027 & \天后的日期是\#028 Else

#029 MsgBox \请输入正确格式的日期!\#030 End If #031 End If #032 End Sub

代码解析：

DatFunctions过程在对话框中输入日期后使用各种日期函数对其进行计算并用消息框显示。

第4、5行代码使用InputBox函数显示一个对话框，供用户在对话框中输入一个日期。 第6行代码使用IsDate函数判断输入的日期是否正确。IsDate函数返回Boolean值，指出一个表达式是否可以转换成日期，语法如下：

IsDate(expression)

11

VBA常用技巧代码解析

参数expression是必需的，日期表达式或字符串表达式，如果表达式是一个日期，或者可以作为有效日期识别，则IsDate函数返回True，否则返回False。

第7行到第22行代码使用Weekday函数判断所输入的日期是星期几。Weekday函数返回一个整数，代表某个日期是星期几，语法如下：

Weekday(date, [firstdayofweek])

参数date是必需的，能够表示日期的 Variant、数值表达式、字符串表达式或它们的组合。

参数firstdayofweek是可选的，指定一星期第一天的常数，如表格 7-1所示。

常数 vbUseSystem VbSunday vbMonday vbTuesday vbWednesday vbThursday vbFriday vbSaturday 值 0 1 2 3 4 5 6 7 描述 使用 NLS API 设置 星期日（缺省值） 星期一 星期二 星期三 星期四 星期五 星期六 表格 7-1 firstdayofweek参数值

Weekday函数返回一个1到7之间的整数，当firstdayofweek参数设置为vbMonday（2）时，返回1时说明是星期一，以此类推。

第23行代码根据系统中指定的短日期格式来显示所输入的日期。DateValue函数的语法如下：

DateValue(date)

参数date是必需的，任何表达式，表示从 100 年 1 月 1 日到 9999 年 12 月 31 日之间的一个日期。如果是一个字符串，且其内容只有数字以及分隔数字的日期分隔符，则 DateValue函数就会根据系统中指定的短日期格式来识别月、日、年的顺序。DateValue函数也识别明确的英文月份名称，全名或缩写均可。例如，除了12/30/1991 和12/30/91 之外，DateValue函数也能识别December 30, 1991 和Dec 30, 1991。

如果date参数中略去了年这一部分，DateValue函数就会使用由计算机系统日期设置的当前年份。

第24行代码判断输入的日期的季度。DatePart函数返回一个包含已知日期的指定时间部分的值，语法如下：

DatePart(interval, date[,firstdayofweek[, firstweekofyear]])

其中参数interval是必需的，字符串表达式，是要返回的时间间隔，设定值如表格 7-2

12

VBA常用技巧代码解析

所示。

设置 yyyy q m y d w ww h n s 说明 年 季 日 一年的日数 日 一周的日数 周 时 分钟 秒 表格 7-2 interval参数设定值

第26行代码计算所输入的日期距当天的天数。DateDiff函数返回两个指定日期间的时间间隔数目，语法如下：

DateDiff(interval, date1, date2[, firstdayofweek[, firstweekofyear]])

其中参数interval是必需的，字符串表达式，表示用来计算date1和date2的时间差的时间间隔，设定值如表格 7-2所示。

参数date1和date2是必需的，计算中要用到的两个日期。

因为如果输入的日期是当前日期以前的日期，DateDiff函数会返回负值，所以使用Abs函数返回绝对值将其转换为正值。

第27行代码计算所输入的日期距当天的天数，DateAdd返回加上了一段时间间隔的一个日期，语法如下：

DateAdd(interval, number, date)

参数interval是必需的，字符串表达式，是所要加上去的时间间隔，设定值如表格 7-2所示。

参数number是必需的，是要加上的时间间隔的数目。其数值可以为正数（得到未来的日期），也可以为负数（得到过去的日期）。

参数date是必需的，需要加上时间间隔的字符串表达式。

运行DatFunctions过程，在显示的对话框中输入一个日期，结果如图 7-1所示。

13

VBA常用技巧代码解析

图 7-1 使用日期函数

技巧8 判断是否为数值

使用IsNumeric函数可以判断表达式的运算结果是否为数值，如下面的代码所示。

#001 Sub Numeric() #002 Dim i As Integer #003 Dim n As String #004 Dim s As String #005 With Sheet1

#006 For i = 1 To .Range(\#007 If IsNumeric(.Cells(i, 1)) Then

#008 n = n & .Cells(i, 1).Address(0, 0) & Chr(9) & .Cells(i, 1) & Chr(13)

#009 Else

#010 s = s & .Cells(i, 1).Address(0, 0) & Chr(9) & .Cells(i, 1) & Chr(13)

#011 End If #012 Next #013 End With

#014 MsgBox \列中数值单元格：\#015 & \列中非数值单元格：\#016 End Sub

14

VBA常用技巧代码解析

代码解析：

Numeric过程使用IsNumeric函数判断工作表的A列单元格是否为数值，并使用消息框显示。

第7行代码判断工作表的A列单元格是否为数值。IsNumeric函数返回Boolean值，指出表达式的运算结果是否为数，语法如下：

IsNumeric(expression)

参数expression是必需的，Variant类型，包含数值表达式或字符串表达式。 如果参数expression的运算结果为数字，则IsNumeric返回True，否则返回False。 第8行代码将数值单元格的地址和数值保存在变量 e中。

第10行代码将非数值单元格的地址和内容保存在变量 s中。在保存时插入制表符对数据列进行分隔，使之排列整齐，请参阅技巧错误！未找到引用源。。

运行Numeric过程结果如图 8-1所示。

图 8-1 判断是否为数值

技巧9 格式化数值、日期和时间

15

VBA常用技巧代码解析

Format函数是VBA中的常用函数，可以实现数值、日期和时间格式的转变，示例代码如下：

#001 Sub FromatCurrent()

#002 MsgBox Format(123456.789, \#003 & Format(123456.789, \#004 & Format(123456.789, \

#005 & Format(-123456.789, \#006 & Format(-123456.789, \￥#,##0.00;(￥#,##0.00)\#007 & Format(Date, \#008 & Format(Date, \#009 & Format(Date, \#010 & Format(Now, \#011 & Format(Now, \#012 End Sub

代码解析：

FromatCurrent过程使用消息框显示格式化后的数值、日期和时间。

Format函数根据格式表达式中的指令来格式化的数值、日期和时间，语法如下：

Format(expression[, format[, firstdayofweek[, firstweekofyear]]])

其中参数expression是必需的，任何有效的表达式。

参数format是可选的，有效的命名表达式或用户自定义格式表达式。 第2行代码将数值格式化为两位小数格式显示。 第3行代码将数值格式化为两位小数的百分比格式显示。 第4行代码将数值格式化为千位分隔符显示。

第5行代码将数值格式化为以美元符号显示的两位小数，以千位分隔符分隔，如果是负值则以小括号显示。

第6行代码将数值格式化为以人民币符号显示的两位小数，以千位分隔符分隔，如果是负值则以小括号显示。

第7行代码将系统日期格式化为“yyyy-mm-dd”格式显示。 第8行代码将系统日期格式化为“yyyymmdd”格式显示。 第9行代码将系统日期格式化为长日期格式显示。

第10行代码将系统时间格式化为24小时、分钟和秒的格式显示。 第11行代码将系统时间格式化为分12小时、分钟和秒的格式显示。

16

VBA常用技巧代码解析

运行FromatCurrent过程结果如图 9-1所示。

图 9-1 格式化数值、日期和时间

技巧10 个人所得税自定义函数

在财务工作中经常需要计算个人所得税，而在Excel中没有计算个人所得税的函数，此时可以使用自定义函数来计算，如下面的代码所示。

#001 Public Function PITax(Income, Optional Threshold) As Single #002 Dim Rate As Single #003 Dim Debit As Single

#004 Dim Taxliability As Single

#005 If IsMissing(Threshold) Then Threshold = 2000 #006 Taxliability = Income - Threshold #007 Select Case Taxliability #008 Case 0 To 500 #009 Rate = 0.05 #010 Debit = 0

#011 Case 500.01 To 2000 #012 Rate = 0.1 #013 Debit = 25

17

VBA常用技巧代码解析

#014 Case 2000.01 To 5000 #015 Rate = 0.15 #016 Debit = 125

#017 Case 5000.01 To 20000 #018 Rate = 0.2 #019 Debit = 375

#020 Case 20000.01 To 40000 #021 Rate = 0.25 #022 Debit = 1375

#023 Case 40000.01 To 60000 #024 Rate = 0.3 #025 Debit = 3375

#026 Case 60000.01 To 80000 #027 Rate = 0.35 #028 Debit = 6375

#029 Case 80000.01 To 10000 #030 Rate = 0.4 #031 Debit = 10375 #032 Case Else #033 Rate = 0.45 #034 Debit = 15375 #035 End Select

#036 If Taxliability <= 0 Then #037 PITax = 0 #038 Else

#039 PITax = Application.Round(Taxliability * Rate - Debit, 2) #040 End If #041 End Function

代码解析：

自定义PITax函数根据应纳税额计算应纳的个人所得税额。

第5行代码设置个人所得税的起征点为2000元，如果以后需要调整起征点，可把2000元改为调整后的起征点。

18

VBA常用技巧代码解析

第6行代码设置全月应纳税所得额等于应纳税收入减去起征点。

第7行到第35行代码根据全月应纳税所得额取得税率和速算扣除数。税率和速算扣除数根据如表格 10-1所示的工资、薪金所得适用个人所得税九级超额累进税率表计算。

级数 一 二 三 四 五 六 七 八 九 全月应纳税所得额（含税所得额） 不超过500元 超过500元至2000元 超过2000元至5000元 超过5000元至20000元 超过20000元至40000元 超过40000元至60000元 超过60000元至80000元 超过80000元至100000元 超过100000元 税率% 5 10 15 20 25 30 35 40 45 速算扣除数（元） 0 25 125 375 1375 3375 6375 10375 15375 表格 10-1 个人所得税九级超额累进税率表

第36行到第40行代码根据应纳税所得额、税率和速算扣除数计算应纳的个人所得税额。其中第39行代码中使用工作表函数Round对计算结果进行四舍五入运算，请参阅技巧5-2。

在工作表中使用自定义PITax函数结果如图 10-1所示。

图 10-1 工作表中使用自定义PITax函数

技巧11 人民币大写函数

在VBA中没有内置的函数进行人民币大写转换，此时可以编写自定义函数进行人民币大写转换，如下面的代码所示。

19

VBA常用技巧代码解析

#001 Public Function RMBDX(M)

#002 RMBDX = Replace(Application.Text(Round(M + 0.00000001, 2), \元\

#003 RMBDX = IIf(Left(Right(RMBDX, 3), 1) = \元\Left(RMBDX, Len(RMBDX) - 1) & \角\分\元\& \角整\零\元整\

#004 RMBDX = Replace(Replace(Replace(Replace(RMBDX, \零元零角\零元\零角\零\负\

#005 End Function

代码解析：

第2行代码首先使用Round函数对小写数字加上极小值后进行四舍五入运算，关于Round函数请参阅技巧5-1。其次使用工作表Text函数将数值转换成人民币大写格式表示的文本。Text函数将数值转换为按指定数字格式表示的文本，语法如下：

TEXT(value,format_text)

Value参数为数值、计算结果为数值的公式，或对包含数值的单元格的引用。 Format_text参数为“单元格格式“对话框中”数字“选项卡上”分类框中的文本形式的数字格式。

最后使用Replace函数将人民币大写格式表示的文本中的小数点替换成“元”。Replace函数返回一个字符串，该字符串中指定的子字符串已被替换成另一子字符串，并且替换发生的次数也是指定的，语法如下：

Replace(expression, find, replace[, start[, count[, compare]]])

其中参数expression是必需的，包含要替换的子字符串。 参数find是必需的，要搜索到的子字符串。 参数replace是必需的，用来替换的子字符串。

参数start是可选的，在表达式中子字符串搜索的开始位置。

第3行代码使用了IIF函数、Left函数、Right函数根据第2行代码返回的人民币大写格式表示的文本中的“元”的位置在文本中插入正确的“元”、“角”、“分”字符，使之符合人民币大写习惯。

IIf函数根据表达式的值，来返回两部分中的其中一个，语法如下：

IIf(expr, truepart, falsepart)

参数expr是必需的，用来判断真伪的表达式。

参数truepart是必需的，如果expr为True，则返回这部分的值或表达式。 参数falsepart是必需的，如果expr为False，则返回这部分的值或表达式。 Left、Right函数请参阅技巧6 。

20

VBA常用技巧代码解析

第4行代码使用Replace函数将人民币大写格式表示的文本中可能出现的“零元零角”、“零元”替换成空白字符；可能出现的“零角”替换成“零”。如果输入负数的话，将“-”替换成“负”。

在工作表中使用自定义RMBDX函数转换人民币大写的效果如图 11-1所示。

图 11-1 人民币大写转换

技巧12 列号转换为列标

使用VBA获取单元格的列号时，只能返回一个数值。如果需要获取以字符表示的列标，可以使用下面的自定义GetColumn函数过程。

#001 Function GetColumn(C As Integer) As String

#002 GetColumn = Split(Cells(1, C).Address, \#003 End Function

代码解析：

GetColumn函数过程代码中，将参数iCol作为列号传递给Cells属性，并获取其绝对地址字串符，然后以“$”字符为分隔符，通过Split函数返回一个一维数组。

Split函数返回一个下标从零开始的一维数组，它包含指定数目的子字符串，语法如下：

Split(expression[, delimiter[, limit[, compare]]])

其中参数expression是必需的，包含子字符串和分隔符的字符串表达式 。如果expression是一个长度为零的字符串(\，则返回一个空数组，即没有元素和数据的数组。

参数delimiter是可选的，用于标识子字符串边界的字符串字符。如果忽略，则使用空格字符(\作为分隔符。

返回一维数组后获取该数组的第2个元素（下标为1），即该列号的字符列标。 下面的代码使用GetColumn函数过程获得所选单元格的字符列标。

21

VBA常用技巧代码解析

#001 Private Sub Worksheet_SelectionChange(ByVal Target As Range) #002 MsgBox GetColumn(Selection.Column) #003 End Sub

在工作表中选择单元格后结果如图 12-1所示。

图 12-1 返回列标字符串

技巧13 判断工作表是否为空表

VBA中没有专门的属性或函数可以判断工作表是否为空白工作表，可以使用自定义函数返回指定工作表是否为空工作表，如下面的代码所示。

#001 Function IsBlankSht(Sh As Variant) As Boolean

#002 If TypeName(Sh) = \#003 If Application.CountA(Sh.UsedRange.Cells) = 0 Then #004 IsBlankSht = True #005 End If #006 End Function

代码解析：

自定义IsBlankSht函数包含一个Variant变量类型的参数，代表工作表名称或者对象名称。如果指定的工作表为空工作表，则该函数返回True。

第2行代码使用TypeName函数判断参数Sh是否为字符串类型（“String”），如果是

22

VBA常用技巧代码解析

字符串，则将以该字符串作为名称的工作表赋值给变量Sh。

第3行代码通过工作表函数CountA统计工作表已使用区域的非空单元格个数，如果统计结果为0，则表示该工作表为空工作表。

现在就可以像使用VBA函数一样使用自定义的IsBlankSht函数，如下面的代码所示。

#001 Sub DelBlankSht() #002 Dim Sh As Worksheet

#003 Application.DisplayAlerts = False #004 For Each Sh In ThisWorkbook.Sheets #005 If IsBlankSht(Sh) Then Sh.Delete #006 Next

#007 Application.DisplayAlerts = True #008 End Sub

代码解析：

使用自定义的IsBlankSht函数删除工作簿中所有空工作表。

第3行代码将Application对象的DisplayAlerts属性设置为False，使删除时不显示系统警告对话框。

第4行到第6行代码，使用For Each...Next语句遍历所有工作表，使用自定义的IsBlankSht函数判断是否为空表，如果为空表则使用Delete方法删除。

注意 自定义IsBlankSht函数仅仅判断工作表单元格区域内容是否为空，如果工作表中存在其它对象（如图形对象、数据有效性、单元格批注等），还需要再进一步判断。

技巧14 查找指定工作表

判断工作簿中是否存在指定名称的工作表，除了使用遍历工作簿中所有工作表的方法外，还可以使用自定义函数，如下面的代码所示。

#001 Function ExistSh(Sh As String) As Boolean #002 Dim Sht As Object #003 On Error Resume Next #004 Set Sht = Sheets(Sh)

23

VBA常用技巧代码解析

#005 If Err.Number = 0 Then ExistSh = True #006 Set Sht = Nothing #007 End Function

代码解析：

自定义ExistSh函数包含一个String类型的参数，代表需要判断的工作表名称。如果该工作表存在，则返回True。

第5行代码判断前面的代码是否出错，如果前面的代码存在错误，则表示不存在指定名称的表。

使用自定义ExistSheet函数判断工作簿中是否存在指定名称的工作表，如下面的代码所示。

#001 Sub NotSht()

#002 Dim Sh As String

#003 Sh = InputBox(\请输入工作表名称：\#004 If Len(Sh) > 0 Then

#005 If Not ExistSh(Sh) Then

#006 MsgBox \对不起,\表不存在!\#007 Else

#008 Sheets(Sh).Select #009 End If #010 End If #011 End Sub

代码解析：

NotSht过程使用自定义的ExistSh函数判断工作簿中是否存在指定名称的工作表，如果不存在则使用消息框进行提示，如图 14-1所示。

图 14-1 查找指定工作表

24

VBA常用技巧代码解析

技巧15 查找指定工作簿是否打开

如果需要判断指定名称的工作簿是否已经打开，除了使用错误！未找到引用源。的方法外，还可以使用与技巧14 类似的自定义函数，如下面的代码所示。

#001 Function ExistWorkbook(WbName As String) As Boolean #002 Dim wb As Workbook #003 On Error Resume Next #004 Set wb = Workbooks(WbName)

#005 If Err.Number = 0 Then ExistWorkbook = True #006 Set wb = Nothing #007 End Function

代码解析：

自定义ExistWorkbook函数判断指定名称的工作簿是否已经打开。

第5行代码判断前面的赋值语句是否存在错误。如果没有指定名称的工作簿，则第4行代码会产生错误，自定义ExistWorkbook函数返回False。

下面使用自定义ExistWorkbook函数判断名称为“Excel Home”的工作簿是否已经打开，如果没有打开则使用消息框进行提示，如图 15-1所示。

#001 Sub NotWorkbook()

#002 If Not (ExistWorkbook(\Home\Then MsgBox \对不起,Excel Home工作簿没有打开!\

#003 End Sub

图 15-1 消息框提示

技巧16 取得应用程序的安装路径

25

VBA常用技巧代码解析

使用自定义函数取得应用程序的安装路径，如下面的代码所示。

#001 Function GetSetupPath(AppName As String) #002 Dim WSH As Object

#003 Set WSH = CreateObject(\

#004 GetSetupPath = WSH.RegRead(\#005 & \#006 & AppName & \#007 Set WSH = Nothing #008 End Function #009 Sub WinRARPath()

#010 MsgBox GetSetupPath(\#011 End Sub

代码解析：

自定义GetSetupPath函数取得应用程序的安装路径，其中参数AppName代表指定的应用程序的名称。

第3行代码使用CreateObject函数将Wscript.Shell对象的引用赋给变量WSH。 CreateObject函数创建并返回一个对ActiveX 对象的引用，语法如下：

CreateObject(class,[servername])

参数class是必需的，Variant (String)，要创建的应用程序名称和类。

参数servername是可选的，Variant (String)，要在其上创建对象的网络服务器名称。如果servername是一个空字符串(\，即使用本地机器。

第4行代码取得AppName参数指定的应用程序在注册表中的路径。

WinRARPath过程使用消息框显示由自定义的GetSetupPath函数取得的应用程序“WinRAR”的安装路径。

运行WinRARPath过程结果如图 16-1所示。

图 16-1 应用程序安装路径

26

VBA常用技巧代码解析

技巧17 数组的使用

17-1

代码运行时创建数组

使用Array函数可以在代码运行时创建数组并把一系列数据保存在数组中，示例代码如下：

#001 Option Base 1 #002 Sub arr()

#003 Dim arr As Variant #004 Dim i As Integer

#005 arr = Array(\王晓明\吴胜玉\周志国\曹武伟\张新发\卓雪梅\\沈煜婷\丁林平\

#006 For i = LBound(arr) To UBound(arr) #007 Cells(i, 1) = arr(i) #008 Next #009 End Sub

代码解析：

Arr过程使用Array函数创建一个数组用来保存数据并将其写入到工作表的单元格区域。

第1行代码使用Option Base语句声明数组下标的缺省下界为1，数组下标的缺省下界默认为0。

第5行代码使用Array函数创建数组用来保存数据。Array函数返回一个包含数组的Variant，语法如下：

Array(arglist)

Arglist参数是一个用逗号隔开的值表，这些值用于给Variant所包含的数组的各元素赋值。如果不提供Arglist参数，则创建一个长度为 0 的数组。

第6行代码使用LBound函数和UBound函数取得数组的最小和最大下标。

LBound函数返回一个Long型数据，其值为指定数组维可用的最小下标，语法如下：

LBound(arrayname[, dimension])

UBound函数返回一个Long型数据，其值为指定数组维可用的最大下标，语法如下：

UBound(arrayname[, dimension])

参数arrayname是必需的，数组变量的名称。

参数dimension是可选的，指定返回哪一维的下界，1表示第一维，2表示第二维，如

27

VBA常用技巧代码解析

此类推。默认为1。

UBound函数与LBound函数一起使用，可以用来确定数组的大小。

第7行代码确定数组的大小后使用For...Next语句遍历数组元素并将数组元素依次写入到工作表的A列单元格中，如图 17-1所示。

图 17-1 将数组元素写入工作表

17-2 文本转换为数组

在处理字符串时可以使用Split 函数将字符串按指定的分隔符分开并以数组返回，代码如下：

#001 Sub Splitarr()

#002 Dim Arr As Variant

#003 Arr = Split(Sheet2.Cells(1, 1), \

#004 Sheet1.Cells(1, 1).Resize(UBound(Arr) + 1, 1) = Application.Transpose(Arr)

#005 End Sub

代码解析：

Splitarr过程使用Split 函数将工作表Sheet2中A1单元格的姓名分别写入到工作表Sheet1中的A列单元格。

Split 函数返回一个下标从零开始的一维数组，包含指定数目的子字符串，语法如下：

Split(expression[, delimiter[, limit[, compare]]])

参数expression是必需的，包含子字符串和分隔符的字符串表达式。

参数delimiter是必需的，用来标识子字符串边界的字符串字符。如果忽略，则使用空格字符(\作为分隔符。

第4行代码，首先使用UBound函数取得返回数组的最大下标后调整单元格区域，因为数组下标的缺省下界默认为0，所以在使用Resize属性调整单元格区域时参数RowSize

28

VBA常用技巧代码解析

需要在返回数组的最大下标上加一。

然后使用工作表Transpose函数将返回数组转置后写入到工作表调整后的单元格区域中。

工作表Transpose函数返回转置单元格区域，即将一行单元格区域转置成一列单元格区域，反之亦然，语法如下：

TRANSPOSE(array)

参数array为需要进行转置的数组或工作表中的单元格区域。

Splitarr过程将如图 17-2所示的工作表单元格中的字符串以逗号分隔后依次写入到工作表的A列单元格中，如图 17-3所示。

图 17-2 工作表单元格中的字符串

29

VBA常用技巧代码解析

图 17-3 文本转换为数组写入单元格

17-3 使用动态数组去除重复值

在技巧17-2中使用数组函数将单元格中的文本进行分隔后写入到工作表Sheet1中的A列单元格，但是如果文本中含有大量的重复值，在写入时也会将重复值写入到工作表中，此时可以使用动态数组去除文本中的重复值，如下面的代码所示。

#001 Sub Splitarr()

#002 Dim Splarr() As String #003 Dim Arr() As String #004 Dim Temp() As String #005 Dim r As Integer

30

VBA常用技巧代码解析

#006 Dim i As Integer #007 On Error Resume Next

#008 Splarr = Split(Sheet2.Range(\#009 For i = 0 To UBound(Splarr) #010 Temp = Filter(Arr, Splarr(i)) #011 If UBound(Temp) < 0 Then #012 r = r + 1

#013 ReDim Preserve Arr(1 To r) #014 Arr(r) = Splarr(i) #015 End If #016 Next

#017 Sheet1.Range(\#018 End Sub

代码解析：

Splitarr过程将工作表Sheet2中A1单元格的文本去除重复值后写入到工作表Sheet1中的A列单元格。

第2行代码声明数组Splarr用来保存Sheet2中A1单元格的文本。 第3行代码声明数组Arr用来保存去除重复值后的文本。 第4行代码声明数组Temp用来判断文本是否重复。 第5行代码声明变量r用来保存去除重复值后的文本数量。

第7行代码启动错误处理程序来忽略错误，因为在程序运行到第11行代码会发生下标越界错误。

第8行代码使用Split 函数以Sheet2中A1单元格的文本创建一个下标从零开始的一维数组。关于Split 函数请参阅技巧17-2。

第9行代码使用For...Next语句遍历数组Splarr的所有元素。

第10行代码使用Filter函数创建一个数组Temp用来保存以当前Splarr数组的值在Arr数组中的搜索结果。Filter函数返回一个下标从零开始的数组，该数组包含基于指定筛选条件的一个字符串数组的子集，语法如下：

Filter(sourcesrray, match[, include[, compare]])

参数sourcesrray是必需的，要执行搜索的一维字符串数组。 参数match是必需的，要搜索的字符串。

参数include是可选的，Boolean值，表示返回子串是否包含match字符串。如果参数include是True，Filter函数返回的是包含match参数子字符串的数组子集。如果参数include

31

VBA常用技巧代码解析

是False，Filter函数返回的是不包含match参数子字符串的数组子集。

参数compare是可选的，所使用的字符串比较类型。

第11行代码根据返回的数组Temp的最大下标来判断当前Splarr数组的值是否重复。在使用使用Filter函数时如果没有相匹配的值，将返回一个空数组，最大下标小于0。

第12行代码如果当前Splarr数组的值不重复则将变量r的值加1。

第13行代码重新定义动态数组大小。ReDim语句，在过程级别中使用，用于为动态数组变量重新分配存储空间，语法如下：

ReDim [Preserve] varname(subscripts) [As type] [, varname(subscripts) [As type]]

参数Preserve是可选的，关键字，当改变原有数组最末维的大小时，使用此关键字可以保持数组中原来的数据。

参数varname是必需的，变量的名称。

参数subscripts是必需的，数组变量的维数，最多可以定义 60 维的多维数组，使用下面的语法；

[lower To] upper [,[lower To] upper]

第14行代码将不重复值添加到数组Arr中。

第15行代码使用工作表Transpose函数将去除重复值的的文本转置后写入到工作表的A列单元格中。

如果需要将去除重复值的的文本写入到第一行单元格中，可以将第15行代码改成下面的代码：

Sheet1.Range(\

如果需要将去除重复值的的文本还是以逗号作为分隔符写入到A1单元格中，可以将第15行代码改成下面的代码：

Sheet1.Range(\

Join函数返回一个字符串，该字符串是通过连接某个数组中的多个子字符串而创建的，语法如下：

Join(sourcearray[, delimiter])

参数sourcearray是必需的，包含被连接子字符串的一维数组。

参数delimiter是可选的，在返回字符串中用于分隔子字符串的字符，如果忽略则使用空格(\来分隔子字符串。

32

本文来源：https://www.bwwdw.com/article/5wt.html