函数是一段可重复使用的代码块，用于执行特定任务并返回一个值
函数的基本结构
Function AddNumbers(a As Integer, b As Integer) As Integer
'函数名：Addnumbers
'参数：a和b都是整数
'返回值：整数
'计算两个数的和
AddNumbers = a + b
End Function
Sub UseFunction()
Dim result As Integer
'调用AddNumbers函数
result = AddNumbers(2, 3)
'显示结果
MsgBox result
End Sub
1.调用工作表函数进行 求和/查找最大值最小值
在对工作表的单元格区域进行求和计算时，使用干工作表Sum函数比使用VBA代码遍历单元格进行累加求和效率要高得多
Sub UseSumFunction()
Dim total As Double
Dim rng As Range
' 设置要计算的范围
Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1:A100")
' 使用WorksheetFunction对象调用SUM函数
total = Application.WorksheetFunction.Sum(rng)
'这里的Sum也可以换成其他Excel自带函数，比如Max/Min等
' 显示结果
MsgBox "The sum is: " & total
End Sub2.不重复的录入
在工作表中录入数据时，有时希望能限制重复值的录入，比如在A列单元格只能录入唯一的编号，此时可以利用工作表的Change事件结合工作表的CountIf函数来判断所录入的人员编号是否重复
Private Sub Worksheet_Change(ByVal Target As Range)
' 声明变量
Dim rng As Range
' 检查是否只有一个单元格被改变，且在A列
If Target.Cells.Count > 1 Or Target.Column <> 1 Then Exit Sub
' 设置要检查的范围（A列）
Set rng = Me.Range("A:A")
' 检查输入值是否在A列中重复
If Application.CountIf(rng, Target.Value) > 1 Then
' 如果重复，显示消息框
MsgBox "不能输入重复的编号!", 64
' 禁用事件以避免无限循环
Application.EnableEvents = False
' 清除输入的值
Target.Value = ""
' 重新启用事件
Application.EnableEvents = True
End If
End Sub
3.获得当月的最后一天
在实际工作中经常需要根据给定的日期计算其所属月份的最后一天，此时可以使用DateSerial函数完成计算
这个函数的一个特殊用法是，当我们将”日”参数设为0时，它会返回上个月的最后一天。我们可以利用这个特性来获取当月的最后一天。
Sub Serial()
' 声明变量
Dim DateStr As String
' 使用DateSerial函数计算当月最后一天
DateStr = Day(DateSerial(Year(Date), Month(Date) + 1, 0))
' 显示结果
MsgBox "本月的最后一天是" & Month(Date) & "月" & DateStr & "号"
End Sub4.进行四舍五入计算
可以使用VBA内置的Round函数
Round函数返回一个数值，该数值是按照指定的小数位数进行四舍五入运算的结果
Round的基本语法是：
Round(number, num_digits)
number表示要四舍五入的数字
num_digits表示要保留的小数位数，默认为0
Sub DemonstrateRounding()
' 声明变量
Dim originalNumber As Double
Dim roundedNumber As Double
' 示例 1: 四舍五入到整数
originalNumber = 3.7
roundedNumber = Round(originalNumber)
Debug.Print "3.7 四舍五入到整数: " & roundedNumber ' 输出: 4
' 示例 2: 四舍五入到一位小数
originalNumber = 3.14159
roundedNumber = Round(originalNumber, 1)
Debug.Print "3.14159 四舍五入到一位小数: " & roundedNumber ' 输出: 3.1
' 示例 3: 四舍五入到两位小数
originalNumber = 2.718
roundedNumber = Round(originalNumber, 2)
Debug.Print "2.718 四舍五入到两位小数: " & roundedNumber ' 输出: 2.72
' 示例 4: 处理负数
originalNumber = -4.5
roundedNumber = Round(originalNumber)
Debug.Print "-4.5 四舍五入到整数: " & roundedNumber ' 输出: -5
' 示例 5: 四舍五入到十位
originalNumber = 1234
roundedNumber = Round(originalNumber, -1)
Debug.Print "1234 四舍五入到十位: " & roundedNumber ' 输出: 1230
End Sub5.常用的字符串函数
Len(Str)
功能：返回字符串的长度（字符数）。
例如：Len(“AbcD EFG hijk Lmn”) 将返回 16。
Left(Str, 8)
功能：返回字符串左边指定数量的字符。
例如：Left(“AbcD EFG hijk Lmn”, 8) 将返回 “AbcD EFG”。
Right(Str, 6)
功能：返回字符串右边指定数量的字符。
例如：Right(“AbcD EFG hijk Lmn”, 6) 将返回 “k Lmn”。
Mid(Str, 2, 5)
功能：从指定位置开始，返回字符串中指定数量的字符。
例如：Mid(“AbcD EFG hijk Lmn”, 2, 5) 将返回 “bcD E”。
UCase(Str)
功能：将字符串转换为大写。
例如：UCase(“AbcD EFG hijk Lmn”) 将返回 “ABCD EFG HIJK LMN”。
LCase(Str)
功能：将字符串转换为小写。
例如：LCase(“AbcD EFG hijk Lmn”) 将返回 “abcd efg hijk lmn”。
6.使用日期函数
Date函数返回当前系统日期
currentDate = Date()Now函数返回当前的日期和时间
currentDateTime = Now()Yea,Month,Day函数返回年月日
Sub ShowDateComponents()
Dim someDate As Date
someDate = #1/15/2023#
MsgBox "年: " & Year(someDate) & vbNewLine & _
"月: " & Month(someDate) & vbNewLine & _
"日: " & Day(someDate)
End SubDateAdd函数向日期添加指定的时间间隔
语法：DateAdd(interval,number,date)
Sub AddToDate()
Dim startDate As Date
startDate = #1/1/2023#
MsgBox "30天后: " & DateAdd("d", 30, startDate) & vbNewLine & _
"2个月后: " & DateAdd("m", 2, startDate) & vbNewLine & _
"1年后: " & DateAdd("yyyy", 1, startDate)
End SubDateDiff函数计算两个日期之间的时间间隔
语法：DateDiff(interval,startdate,enddate)
Sub CalculateDateDifference()
Dim date1 As Date, date2 As Date
date1 = #1/1/2023#
date2 = #12/31/2023#
MsgBox "相差的天数: " & DateDiff("d", date1, date2) & vbNewLine & _
"相差的月数: " & DateDiff("m", date1, date2) & vbNewLine & _
"相差的周数: " & DateDiff("ww", date1, date2)
End SubDateSerial函数根据指定的年月日创建日期
语法：DateSerial(year,month,day)
Sub CreateDate()
Dim newDate As Date
newDate = DateSerial(2023, 12, 31)
MsgBox "创建的日期: " & newDate
End SubWeekDay函数返回表示一周中某一天的数字（1-7）
星期日表示1
语法：WeekDay(date,[firstdayofweek])
Sub ShowWeekDay()
Dim someDate As Date
someDate = #8/13/2024#
MsgBox "8/13/2024 是星期 " & WeekdayName(Weekday(someDate))
End Sub7.格式化数值、日期和时间
Format函数是VBA中的常见函数，可以实现数值、日期和时间格式的转变
' 定义一个名为FromatCurrent的子程序
Sub FromatCurrent()
' 使用MsgBox显示格式化后的数字,格式为两位小数,并在末尾添加换行符
MsgBox Format(123456.789, "0.00") & Chr(13)
' 使用Format函数格式化数字为两位小数,并在末尾添加换行符
& Format(123456.789, "0.00") & Chr(13)
' 使用Format函数格式化数字,添加千位分隔符和两位小数,并在末尾添加换行符
& Format(123456.789, "##,##0.00") & Chr(13)
' 使用Format函数格式化负数,使用美元符号,括号表示负值,并在末尾添加换行符
& Format(-123456.789, "$#,##0.00;($#,##0.00)") & Chr(13)
' 使用Format函数格式化负数,使用日元符号,括号表示负值,并在末尾添加换行符
& Format(-123456.789, "¥#,##0.00(¥#,##0.00)") & Chr(13)
' 使用Format函数格式化当前日期为"年-月-日"格式,并在末尾添加换行符
& Format(Date, "yyyy-mm-dd") & Chr(13)
' 使用Format函数格式化当前日期为"年月日"格式(无分隔符),并在末尾添加换行符
& Format(Date, "yyyymmdd") & Chr(13)
' 使用Format函数将当前日期格式化为长日期格式,并在末尾添加换行符
& Format(Date, "Long Date") & Chr(13)
' 使用Format函数格式化当前时间为"时:分:秒"格式,并在末尾添加换行符
& Format(Now, "hh:mm:ss") & Chr(13)
' 使用Format函数格式化当前时间,包含AM/PM标识
& Format(Now, "hh:mm:ss AMPM")
' 结束子程序
End Sub8.将数字转换成人民币大写（可以在单元格中调用该函数）
需要把代码插入到模块中
Public Function RMBDX(M As Double) As String
' 步骤1: 将输入数字转换为中文大写
RMBDX = Replace(Application.Text(Round(M + 0.00000001, 2), "[DBnum2]"), "〇", "零")
' 步骤2: 分离整数部分和小数部分
Dim intPart As String, decPart As String
intPart = Left(RMBDX, Len(RMBDX) - 2)
decPart = Right(RMBDX, 2)
' 处理整数部分
If intPart <> "" Then
intPart = intPart & "元"
End If
' 处理小数部分
Select Case decPart
Case "零零"
decPart = "整"
Case Else
If Left(decPart, 1) = "零" Then
decPart = Right(decPart, 1) & "分"
Else
decPart = Left(decPart, 1) & "角" & Right(decPart, 1) & "分"
End If
End Select
' 合并整数和小数部分
RMBDX = intPart & decPart
' 步骤3: 清理结果
RMBDX = Replace(Replace(Replace(Replace(RMBDX, "零元", ""), "零零", "零"), "零角", ""), "零分", "")
' 处理特殊情况
If RMBDX = "" Then RMBDX = "零元整"
End Function9.判断工作表是否为空表
遍历所有工作表，并且弹出msgbox，显示哪些工作表是空表
Sub AnalyzeAllSheets()
Dim ws As Worksheet
Dim emptySheets As New Collection
Dim nonEmptySheets As New Collection
' 禁用屏幕更新以提高性能
Application.ScreenUpdating = False
' 遍历所有工作表
For Each ws In ThisWorkbook.Worksheets
If IsSheetEmpty(ws) Then
' 如果工作表为空，添加到空表集合
emptySheets.Add ws.Name
Else
' 如果工作表不为空，添加到非空表集合
nonEmptySheets.Add ws.Name
End If
Next ws
' 重新启用屏幕更新
Application.ScreenUpdating = True
' 显示结果
DisplayResults emptySheets, nonEmptySheets
End Sub
Function IsSheetEmpty(ws As Worksheet) As Boolean
' 检查已使用区域是否只有一个单元格，且该单元格为空
IsSheetEmpty = (ws.UsedRange.Cells.Count = 1 And ws.UsedRange.Cells(1).Value = "")
End Function
Sub DisplayResults(emptySheets As Collection, nonEmptySheets As Collection)
Dim msg As String
Dim i As Long
' 构建消息字符串
msg = "空白工作表 (" & emptySheets.Count & "):" & vbNewLine
For i = 1 To emptySheets.Count
msg = msg & " - " & emptySheets(i) & vbNewLine
Next i
msg = msg & vbNewLine & "非空工作表 (" & nonEmptySheets.Count & "):" & vbNewLine
For i = 1 To nonEmptySheets.Count
msg = msg & " - " & nonEmptySheets(i) & vbNewLine
Next i
' 显示消息框
MsgBox msg, vbInformation, "工作表分析结果"
End Sub10.查找指定工作簿是否打开
如果需要判断指定名称的工作簿是否已经打开
函数部分
Function IsWorkbookOpen(workbookName As String) As Boolean
Dim wb As Workbook
' 遍历所有打开的工作簿
For Each wb In Workbooks
' 比较工作簿名称（不区分大小写）
If StrComp(wb.Name, workbookName, vbTextCompare) = 0 Then
IsWorkbookOpen = True
Exit Function
End If
Next wb
' 如果没有找到匹配的工作簿，返回 False
IsWorkbookOpen = False
End Function调用方法
Sub TestIsWorkbookOpen()
Dim workbookName As String
workbookName = "Example.xlsx"
If IsWorkbookOpen(workbookName) Then
MsgBox "工作簿 '" & workbookName & "' 已打开。"
Else
MsgBox "工作簿 '" & workbookName & "' 未打开。"
End If
End Sub11.取得应用程序的安装路径
Function GetAppPathFromRegistry(appName As String) As String
Dim ws As Object
Dim regPath As String
Dim appPath As String
Set ws = CreateObject("WScript.Shell")
' 尝试从 HKEY_LOCAL_MACHINE 读取
regPath = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\" & appName & "\"
On Error Resume Next
appPath = ws.RegRead(regPath)
On Error GoTo 0
' 如果在 HKLM 中没有找到，尝试 HKEY_CURRENT_USER
If appPath = "" Then
regPath = "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\" & appName & "\"
On Error Resume Next
appPath = ws.RegRead(regPath)
On Error GoTo 0
End If
GetAppPathFromRegistry = appPath
End Function
Sub TestGetAppPath()
Dim appPath As String
' 尝试获取 Notepad++ 的路径（假设已安装）
appPath = GetAppPathFromRegistry("notepad++.exe")
If appPath <> "" Then
MsgBox "Notepad++ 的路径是: " & appPath, vbInformation
Else
MsgBox "未能找到 Notepad++ 的路径。", vbExclamation
End If
End Sub12.数组的使用
数组时一种数据结构，用于存储同一类型的多个元素。可以将数组想象成一个有编号的盒子列表，每个盒子可以存放一个值。
VBA中，有几种不同类型的数组：
静态数组：大小固定，在声明时确定
动态数组：大小可变，可以在运行时调整
多维数组：可以有多个维度，如二维、三维等
声明数组
'声明静态数组
Dim myArray(6) As Integer ' 声明一个包含 7 个元素的整数数组（索引 0 到 6）
'声明动态数组
Dim myDynamicArray() As String ' 声明一个动态字符串数组
ReDim myDynamicArray(10) ' 调整数组大小为 11 个元素（索引 0 到 10）
'声明静态数组和声明动态数组在语法上的区别是，
'静态数组在声明时就确定了大小，且声明后大小不可改变
'动态数组在声明时不指定大小，可以在程序运行时调整其大小
'声明多维数组
Dim myMatrix(2, 2) As Double ' 声明一个 3x3 的二维数组初始化数组
' 使用 Array 函数（返回 Variant 类型的数组）
Dim fruits As Variant
fruits = Array("Apple", "Banana", "Cherry")
' 逐个赋值
Dim numbers(2) As Integer
numbers(0) = 10
numbers(1) = 20
numbers(2) = 30
' 使用 For 循环
Dim i As Integer
For i = 0 To 2
numbers(i) = i * 10
Next i数组函数
VBA提供了几个有用的数组函数
LBound(array)：返回数组的下界（最小索引）
UBound(array)：返回数组的商界（最大索引）
Erase array：清除数组内容（对动态数组，还会释放内存）
遍历数组
Sub LoopThroughArray()
Dim numbers(4) As Integer
Dim i As Integer
' 初始化数组
For i = 0 To 4
numbers(i) = i * 10
Next i
' 遍历并打印数组元素
For i = LBound(numbers) To UBound(numbers)
Debug.Print numbers(i)
Next i
End Sub
1 thought on “9.函数的使用——《VBA常用技巧代码解析》”