1、 1函数的使用技巧 1 调用工作表函数求和在对工作表的单元格区域进行求和计算时，使用工作表 Sum 函数比使用 VBA 代码遍历单元格进行累加求和效率要高得多，代码如下所示。#001 Sub rngSum()#002 Dim rng As Range#003 Dim d As Double#004 Set rng = Range(“A1:F7“)#005 d = Application.WorksheetFunction.Sum(rng)#006 MsgBox rng.Address(0, 0) ($#,#0.00)“) (￥ #,#0.00)“) & Chr(13) _#007 & Form
2、at(Date, “yyyy-mm-dd“) & Chr(13) _#008 & Format(Date, “yyyymmdd“) & Chr(13) _#009 & Format(Date, “Long Date“) & Chr(13) _#010 & Format(Now, “hh:mm:ss“) & Chr(13) _#011 & Format(Now, “hh:mm:ss AMPM“)#012 End Sub代码解析：FromatCurrent 过程使用消息框显示格式化后的数值、日期和时间。Format 函数根据格式表达式中的指令来格式化的数值、日期和时间，语法如下：Format(ex
3、pression, format, firstdayofweek, firstweekofyear)其中参数 expression 是必需的，任何有效的表达式。参数 format 是可选的，有效的命名表达式或用户自定义格式表达式。第 2 行代码将数值格式化为两位小数格式显示。第 3 行代码将数值格式化为两位小数的百分比格式显示。第 4 行代码将数值格式化为千位分隔符显示。第 5 行代码将数值格式化为以美元符号显示的两位小数，以千位分隔符分隔，如果是负值则以小括号显示。第 6 行代码将数值格式化为以人民币符号显示的两位小数，以千位分隔符分隔，如果是负值则以小括号显示。第 7 行代码将系统日期格式
4、化为“yyyy-mm-dd”格式显示。第 8 行代码将系统日期格式化为“yyyymmdd”格式显示。第 9 行代码将系统日期格式化为长日期格式显示。第 10 行代码将系统时间格式化为 24 小时、分钟和秒的格式显示。第 11 行代码将系统时间格式化为分 12 小时、分钟和秒的格式显示。16运行 FromatCurrent 过程结果如 图 161-1 所示。图 9-1 格式化数值、日期和时间技巧 10 个人所得税自定义函数在财务工作中经常需要计算个人所得税，而在 Excel 中没有计算个人所得税的函数，此时可以使用自定义函数来计算，如下面的代码所示。#001 Public Function PI
5、Tax(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
6、 To 2000#012 Rate = 0.1#013 Debit = 2517#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
7、#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#005 If Not ExistSh(Sh) Then#006 MsgBox “对不起,“ & Sh & “表不存在!“#007 Else#008 Sheets(Sh).Select#009 End If#010 End If#01
8、1 End Sub代码解析：NotSht 过程使用自定义的 ExistSh 函数判断工作簿中是否存在指定名称的工作表，如果不存在则使用消息框进行提示，如 图 166-1 所示。图 14-1 查找指定工作表24技巧 15 查找指定工作簿是否打开如果需要判断指定名称的工作簿是否已经打开，除了使用 Error! Reference source not found.的方法外，还可以使用与 技巧 14 类似的自定义函数，如下面的代码所示。#001 Function ExistWorkbook(WbName As String) As Boolean#002 Dim wb As Workbook#003
9、 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”的
10、工作簿是否已经打开，如果没有打开则使用消息框进行提示，如 图 167-1 所示。#001 Sub NotWorkbook()#002 If Not (ExistWorkbook(“Excel Home“) Then MsgBox “对不起,Excel Home 工作簿没有打开 !“#003 End Sub图 15-1 消息框提示技巧 16 取得应用程序的安装路径25使用自定义函数取得应用程序的安装路径，如下面的代码所示。#001 Function GetSetupPath(AppName As String)#002 Dim WSH As Object#003 Set WSH = Create
11、Object(“Wscript.Shell“)#004 GetSetupPath = WSH.RegRead(“HKEY_LOCAL_MACHINESoftware“ _#005 & “MicrosoftWindowsCurrentVersionApp Paths“ _#006 & AppName & “Path“)#007 Set WSH = Nothing#008 End Function#009 Sub WinRARPath()#010 MsgBox GetSetupPath(“WinRAR.exe“)#011 End Sub代码解析：自定义 GetSetupPath 函数取得应用程序的
12、安装路径，其中参数 AppName 代表指定的应用程序的名称。第 3 行代码使用 CreateObject 函数将 Wscript.Shell 对象的引用赋给变量 WSH。CreateObject 函数创建并返回一个对 ActiveX 对象的引用，语法如下：CreateObject(class,servername)参数 class 是必需的，Variant (String)，要创建的应用程序名称和类。参数 servername 是可选的，Variant (String)，要在其上创建对象的网络服务器名称。如果 servername 是一个空字符串(“)，即使用本地机器。第 4 行代码取得 A
13、ppName 参数指定的应用程序在注册表中的路径。WinRARPath 过程使用消息框显示由自定义的 GetSetupPath 函数取得的应用程序“WinRAR”的安装路径。运行 WinRARPath 过程结果如 图 168-1 所示。图 16-1 应用程序安装路径26技巧 17 数组的使用17-1 代码运行时创建数组使用 Array 函数可以在代码运行时创建数组并把一系列数据保存在数组中，示例代码如下：#001 Option Base 1#002 Sub arr()#003 Dim arr As Variant#004 Dim i As Integer#005 arr = Array(“王晓
14、明 “, “吴胜玉“, “周志国“, “曹武伟“, “张新发“, “卓雪梅“, “沈煜婷 “, “丁林平 “)#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，语法
15、如下：Array(arglist)Arglist 参数是一个用逗号隔开的值表，这些值用于给 Variant 所包含的数组的各元素赋值。如果不提供 Arglist 参数，则创建一个长度为 0 的数组。第 6 行代码使用 LBound 函数和 UBound 函数取得数组的最小和最大下标。LBound 函数返回一个 Long 型数据，其值为指定数组维可用的最小下标，语法如下：LBound(arrayname, dimension)UBound 函数返回一个 Long 型数据，其值为指定数组维可用的最大下标，语法如下：UBound(arrayname, dimension)参数 arrayname 是
16、必需的，数组变量的名称。27参数 dimension 是可选的，指定返回哪一维的下界，1 表示第一维，2 表示第二维，如此类推。默认为 1。UBound 函数与 LBound 函数一起使用，可以用来确定数组的大小。第 7 行代码确定数组的大小后使用 For.Next 语句遍历数组元素并将数组元素依次写入到工作表的 A 列单元格中，如 图 169-1 所示。图 17-1 将数组元素写入工作表17-2 文本转换为数组在处理字符串时可以使用 Split 函数将字符串按指定的分隔符分开并以数组返回，代码如下：#001 Sub Splitarr()#002 Dim Arr As Variant#003
17、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
18、 是必需的，包含子字符串和分隔符的字符串表达式。参数 delimiter 是必需的，用来标识子字符串边界的字符串字符。如果忽略，则使用空格字符(“ “)作为分隔符。第 4 行代码，首先使用 UBound 函数取得返回数组的最大下标后调整单元格区域，因28为数组下标的缺省下界默认为 0，所以在使用 Resize 属性调整单元格区域时参数 RowSize需要在返回数组的最大下标上加一。然后使用工作表 Transpose 函数将返回数组转置后写入到工作表调整后的单元格区域中。工作表 Transpose 函数返回转置单元格区域，即将一行单元格区域转置成一列单元格区域，反之亦然，语法如下：TRANSPO
19、SE(array)参数 array 为需要进行转置的数组或工作表中的单元格区域。Splitarr 过程将如 图 169-2 所示的工作表单元格中的字符串以逗号分隔后依次写入到工作表的 A 列单元格中，如 图 169-3 所示。图 17-2 工作表单元格中的字符串29图 17-3 文本转换为数组写入单元格17-3 使用动态数组去除重复值在技巧 17-2 中使用数组函数将单元格中的文本进行分隔后写入到工作表 Sheet1 中的A 列单元格，但是如果文本中含有大量的重复值，在写入时也会将重复值写入到工作表中，此时可以使用动态数组去除文本中的重复值，如下面的代码所示。#001 Sub Splitarr
20、()#002 Dim Splarr() As String#003 Dim Arr() As String#004 Dim Temp() As String#005 Dim r As Integer30#006 Dim i As Integer#007 On Error Resume Next#008 Splarr = Split(Sheet2.Range(“a1“), “,“)#009 For i = 0 To UBound(Splarr)#010 Temp = Filter(Arr, Splarr(i)#011 If UBound(Temp) 0 Then#012 r = r + 1#01
21、3 ReDim Preserve Arr(1 To r)#014 Arr(r) = Splarr(i)#015 End If#016 Next#017 Sheet1.Range(“a1“).Resize(r, 1) = Application.Transpose(Arr)#018 End Sub代码解析：Splitarr 过程将工作表 Sheet2 中 A1 单元格的文本去除重复值后写入到工作表 Sheet1中的 A 列单元格。第 2 行代码声明数组 Splarr 用来保存 Sheet2 中 A1 单元格的文本。第 3 行代码声明数组 Arr 用来保存去除重复值后的文本。第 4 行代码声明数组
22、 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 参数子字符串的数组子集。如果参数
