标签：VBA，自定义函数
在VBA中处理日期会有些麻烦，当试图将字符串转换为日期时，可能会遇到意想不到的结果，例如：
—日期、月份和年份可能会被无意中交换或更改。
—通常认为不正确的日期格式实际上可能被VBA认为是有效的。
示例1：
DateSerial函数参数总是按以下顺序排列：年、月、日，这是一件好事，因为我们不会感到困惑。然而，使用DateSerial函数时的一个问题是，它接受我们通常认为错误的值，如第32天或第20个月。如下面的示例：
代码语言：javascript复制Sub test_1()
Debug.Print DateSerial(2024, 1, 32) '返回:2024-2-1 , 因为1月32日成为2月1日
Debug.Print DateSerial(2024, 20, 3) '返回：2025-8-3
End Sub让我们考虑这个例子：
已经设置了一个文本框，用户应该在其中以“d-m-y”格式输入日期。但是，假设用户键入“2-13-24”，这是不正确的，因为没有第13个月。发生这种情况的原因有两种可能性：
1.用户可能认为它是m-d-y格式的，但这不正确。
2.可能只是打字错误，即使用户理解了预期的格式，错误仍然可能发生。
为了解决这些问题，这里编写一个名为Correct_Date的函数，以便在将文本转换为日期时获得正确的日期，比只使用CDate或SerialDate函数更可靠。
代码语言：javascript复制'在该函数中, 什么是有效日期具有以下标准：
'年份必须是2或4位数字或为空. 如果它是两位数字, 那么它前面将加上"20".如果它是空白的，那么它将是今年.
'在使用DateSerial函数从文本到日期的转换获得的结果中, 日、月和年不会更改.
'参数:
'1. date_format: "d-m-y" 或"m-d-y" 或"y-m-d"
'2. txt_Date: 输入字符串, 例如"12-6-2024",分隔符可以是下列之一: -/.
'3. Output_date:日期变量, 用于存储从文本到日期转换获得的日期
Function Correct_Date(ByVal date_format As String, ByVal txt_Date As String, ByRef Output_date As Date) As Boolean
Dim TD As Date
Dim dt As Variant
Dim a, b, c
Output_date = Empty
txt_Date = WorksheetFunction.Trim(txt_Date)
txt_Date = Replace(txt_Date, "-", "/")
txt_Date = Replace(txt_Date, ".", "/")
txt_Date = Replace(txt_Date, "", "/")
If IsDate(txt_Date) Then
dt = Split(txt_Date, "/")
If UBound(dt) = 1 Then
If LCase(date_format) = "dmy" Or LCase(date_format) = "mdy" Then
txt_Date = txt_Date & "/" & Year(Date)
Else
txt_Date = Year(Date) & "/" & txt_Date
End If
dt = Split(txt_Date, "/")
End If
Select Case LCase(date_format)
Case "dmy": a = dt(2): b = dt(1): c = dt(0)
Case "mdy": a = dt(2): b = dt(0): c = dt(1)
Case "ymd": a = dt(0): b = dt(1): c = dt(2)
Case Else
MsgBox "Correct_Date函数的第一个参数必须是'dmy'或'mdy' 或'ymd'."
Exit Function
End Select
If IsDate(txt_Date) And (a Like "####" Or a Like "##") Then
If a Like "##" Then a = "20" & a
On Error Resume Next
TD = DateSerial(a, b, c)
If Err.Number = 0 Then
If Year(TD) = Val(a) And Month(TD) = Val(b) And Day(TD) = Val(c) Then
Correct_Date = True
Output_date = TD
End If
End If
On Error GoTo 0
End If
End If
End Function在该函数中，什么是有效日期具有以下标准：年份必须是2位或4位数字或为空。如果它是两位数字，那么它前面将加上“20”；如果它是空白的，那么它将是今年。
在使用DateSerial函数从文本到日期的转换中获得的结果中，日、月和年不会更改。
该函数返回两个值：
1.一个布尔值，用于检查输入文本是否为有效的日期输入。
2.实际日期值。如果输入有效，它会根据选择的日期格式，通过文本到日期的转换生成日期。
如何使用此函数：
需要从三种格式中选择一种：dmy、mdy或ymd，然后将其设置为函数的第一个参数（ByVal date_format as String）。
例如，假设有一个文本框（在工作表中），希望用户输入dmy格式的日期，然后按命令按钮将日期输入到单元格A1。可以这样做：
代码语言：javascript复制Private Sub CommandButton1_Click()
Dim myDate As Date
Dim tx As String
tx = TextBox1
If Correct_Date("dmy", tx, myDate) Then '使用d-m-y 格式
Range("A1") = myDate
Else
MsgBox "错误输入"
End If
End Sub如下图1所示。
图1
回到用户在d-m-y设置中键入“2-13-24”的示例。Correct_Date函数将拒绝此输入，可以设置一个消息框，提示用户识别错误。
当然，如果用户认为它是m-d-y格式，并输入类似“1-2-24”的内容，并认为它是1月2日，而代码会将其读取为2月1日，这就有问题了。不幸的是，在这种情况下，函数无法识别此问题。
但是，为了解决这种情况，可以显示另一个消息框，显示使用月份名称输入的日期，并为用户提供取消的选项。例如：
代码语言：javascript复制Private Sub CommandButton1_Click()
Dim myDate As Date
Dim tx As String
tx = TextBox1
If Correct_Date("dmy", tx, myDate) Then
If MsgBox("你正在输入这个日期: " & Format(myDate, "dd-mmmm-yyyy"), vbOKCancel, "") = vbOK Then
Range("A1") = myDate
End If
Else
MsgBox "错误输入. 请按d-m-y格式输入日期, 例如'15-2-2024'"
End If
End Sub使用下面的代码测试：
代码语言：javascript复制Sub test_2()
Dim myDate As Date
'返回TRUE
Debug.Print Correct_Date("dmy", "1-2-2024", myDate)
Debug.Print Correct_Date("dmy", "13-2-2024", myDate)
Debug.Print Correct_Date("dmy", "1-2-24", myDate)
Debug.Print Correct_Date("dmy", "1/2/2024", myDate)
Debug.Print Correct_Date("dmy", "1/2", myDate)
Debug.Print Correct_Date("dmy", "1.2.24", myDate)
'返回FALSE
Debug.Print Correct_Date("dmy", "1-13-2024", myDate)
Debug.Print Correct_Date("dmy", "31-4-2024", myDate)
End Sub注：本文学习整理自mrexcel.com。
欢迎在下面留言，完善本文内容，让更多的人学到更完美的知识。
