Excel VBA 校验日期范围2000-2099年格式MM/DD/YYYY

最新推荐文章于 2025-03-28 17:52:33 发布

原创最新推荐文章于 2025-03-28 17:52:33 发布 · 3.4k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#excel vba #正则表达式

Excel 专栏收录该内容

16 篇文章

订阅专栏

本文介绍了一个VBA宏脚本，用于在Excel中批量检查和修正指定列中的日期格式，确保其符合特定的标准格式（mm/dd/yyyy），并对不符合格式的数据进行标记。

Function CI(c) 'Cells.Address.Information
    If IsNumeric(c) Then
        On Error GoTo NumErr
        CI = Replace(Cells(, c).Address(0, 0), 1, "")
    Else
        On Error GoTo TxtErr
        CI = Range(c & 1).Column
    End If
    Exit Function
NumErr:
    CI = "Not 1-" & Cells(Cells.Count).Column & " !": Exit Function
TxtErr:
    CI = Cells(Cells.Count).Address(1, 0)
    CI = "Not A-" & Left(CI, InStr(CI, "$") - 1) & " !": Exit Function
End Function

Public Sub ChDate()
Dim i As Integer, re As Object, ColumnLetter As String
ColumnLetter = "I"
Set re = CreateObject("VBscript.regexp")
re.Pattern = "((((0[13578]|1[02])\/(0[1-9]|[12][0-9]|3[01]))|((0[469]|11)\/(0[1-9]|[12][0-9]|30))|(02\/(0[1-9]|[1][0-9]|2[0-8])))\/(20[0-9]{2}))|(02\/29\/(20(0[48]|[2468][048]|[13579][26])|2000))"
For i = 2 To Cells(Rows.Count, CI(ColumnLetter)).End(3).Row Step 1
    Range(ColumnLetter & i).Value = Trim(Range(ColumnLetter & i).Value)
    If TypeName(Range(ColumnLetter & i).Value) = "Date" Then
        Range(ColumnLetter & i) = Format(Date, "mm/dd/yyyy")
    ElseIf IsNumeric(Range(ColumnLetter & i).Value) Then
        Range(ColumnLetter & i).Value = CDate(Range(ColumnLetter & i).Value)
        Range(ColumnLetter & i) = Format(Date, "mm/dd/yyyy")
    End If
Next i

For i = 2 To Cells(Rows.Count, CI(ColumnLetter)).End(3).Row Step 1
If Not re.Test(WorksheetFunction.Text(Range(ColumnLetter & i).Value, "mm/dd/yyyy")) And Range(ColumnLetter & i).Value <> "" Then
    Range(ColumnLetter & i).Interior.Color = RGB(255, 255, 0)
End If
Next i
End Sub