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

来源:互联网 发布:我想做淘宝兼职 编辑:程序博客网 时间:2024/06/05 07:29
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 FunctionNumErr:    CI = "Not 1-" & Cells(Cells.Count).Column & " !": Exit FunctionTxtErr:    CI = Cells(Cells.Count).Address(1, 0)    CI = "Not A-" & Left(CI, InStr(CI, "$") - 1) & " !": Exit FunctionEnd FunctionPublic Sub ChDate()Dim i As Integer, re As Object, ColumnLetter As StringColumnLetter = "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 IfNext iFor i = 2 To Cells(Rows.Count, CI(ColumnLetter)).End(3).Row Step 1If 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 IfNext iEnd Sub

0 0