通过VBA，当在EXCEL单元格中输入任意的日期格式时，都能自动转换为指定的标准格式的日期值

在日常录入EXCEL表格的单元格里，我们输入一些一般性的日期内容，如：2017-10-17 或 2017/10/17时，EXCEL会自动识别为日期并按单元格设计格式显示，单元格中存储的值也是日期格式的值。

但我们进行不规范的日期输入时，如在单元格中输入：2017.10.10或2017。10。10或20171010时，EXCEL不会自动识别这些内容为日期，而只会识别为字符串（文本），且在单元格中存储的也只是文本而已。

我们通过编写VBA代码可以轻松解决此问题，让EXCEL完美识别输入的任何日期内容，不管是20171010或2017.10.10还是201711或20170101或2017131都可被正确识别，而且是直接将单元格中存储的值转换为日期值，不仅仅是显示格式的转换。

闲话不说，直接让VBA代码：

(要录入VBA代码，必须通过EXCEL进入VBA编辑器，这部分内容可搜索下)

'以下代码都要放到一个sheet的类模块之中

Dim nDate

Private Sub Worksheet_Activate()'加载sheet的事件

    nDate = InputBox("请确定此工作表中第几列为日期型的数据！", "输入数字", "")

    If nDate = "" Then

        nDate = 2 '--只操作指定的列号的列，目前只操作B列（第2列）

    Else

        nDate = Val(nDate)

    End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)'--sheet中任何地方发生数据改变时触发的事件

    If nDate =  Then Exit Sub

    If Target.Cells.Column = nDate Then '--如果是第二列才检验文本为日期

        Target.Value = TryChangeDate2(Target.Value)

    End If

End Sub

Public Function TryChangeDate2(ByVal strDATEcome As String) As Variant

    On Error GoTo TryChangeDate2ERR

    Dim strDATE As String

    strDATE = Trim(strDATEcome)

    Dim myDate As Date

    Dim strK As String

    strK = mTrim(strDATEcome)

    Dim k As Integer, nkkkk As Integer

    k = -

k0:

    k =

    myDate = DateValue(strDATE)

    myDate = Format(myDate, "yyyy/m/d")

    TryChangeDate2 = myDate

    Exit Function

k1:

    k =

    myDate = DateValue(strDATE)

    myDate = Format(myDate, "yyyy/m/d")

    TryChangeDate2 = myDate

    Exit Function

TryChangeDate2ERR:

    Err.Clear

    If k =  Then

        nkkkk = Len(strK)

        Select Case nkkkk

            Case

                If InStr(, strK, ".") =  And InStr(, strK, ",") =  And InStr(, strK, "/") =  And InStr(, strK, "\") =  And InStr(, strK, "-") =  Then

                    strDATE = Left(strK, ) & "/" & Mid(strK, , ) & "/" & Mid(strK, , )

                End If

            Case

                If InStr(, strK, ".") =  And InStr(, strK, ",") =  And InStr(, strK, "/") =  And InStr(, strK, "\") =  And InStr(, strK, "-") =  Then

                    If Val(Mid(strK, , )) >=  Then

                        strDATE = Left(strK, ) & "/" & Mid(strK, , ) & "/" & Mid(strK, , )

                    Else

                        strDATE = Left(strK, ) & "/" & Mid(strK, , ) & "/" & Mid(strK, , )

                    End If

                End If

            Case

                If InStr(, strK, ".") =  And InStr(, strK, ",") =  And InStr(, strK, "/") =  And InStr(, strK, "\") =  And InStr(, strK, "-") =  Then

                    If Left(strK, ) = "" Or Left(strK, ) = "" Then

                        strDATE = Left(strK, ) & "/" & Mid(strK, , ) & "/" & Mid(strK, , )

                    Else

                        strDATE = Left(strK, ) & "/" & Mid(strK, , ) & "/" & Mid(strK, , )

                    End If

                    GoTo theEnd

                End If

                    strDATE = Left(strK, ) & "/" & Mid(strK, , ) & "/" & Mid(strK, , )

            Case

                If InStr(, strK, ".") =  And InStr(, strK, ",") =  And InStr(, strK, "/") =  And InStr(, strK, "\") =  And InStr(, strK, "-") =  Then

                    If Val(Mid(strK, , )) >=  Then

                        strDATE = Left(strK, ) & "/" & Mid(strK, , ) & "/" & Mid(strK, , )

                    Else

                        strDATE = Left(strK, ) & "/" & Mid(strK, , ) & "/" & Mid(strK, , )

                    End If

                Else

                    If Val(Mid(strK, , )) >=  Then

                        strDATE = Left(strK, ) & "/" & Mid(strK, , ) & "/" & Mid(strK, , )

                    Else

                        strDATE = Left(strK, ) & "/" & Mid(strK, , ) & "/" & Mid(strK, , )

                    End If

                End If

            Case

                If InStr(, strK, ".") =  And InStr(, strK, ",") =  And InStr(, strK, "/") =  And InStr(, strK, "\") =  And InStr(, strK, "-") =  Then

                    strDATE = Left(strK, ) & "/" & Mid(strK, , ) & "/" & Mid(strK, , )

                Else

                    strDATE = Left(strK, ) & "/" & Mid(strK, , ) & "/" & Mid(strK, , )

                End If

            Case

                If Val(Mid(strK, , )) >=  Then

                    strDATE = Left(strK, ) & "/" & Mid(strK, , ) & "/" & Mid(strK, , )

                Else

                    strDATE = Left(strK, ) & "/" & Mid(strK, , ) & "/" & Mid(strK, , )

                End If

            Case

                strDATE = Left(strK, ) & "/" & Mid(strK, , ) & "/" & Mid(strK, , )

        End Select

theEnd:

        GoTo k1

    End If

    TryChangeDate2 = strDATEcome

End Function

Public Function mTrim(ByVal strCome As String) As String

'--此函数的作用是去掉字符串中间的空格

On Error GoTo mTrimErr

    Dim i As Integer, j As Integer

    Dim strLS As String, k As String * , strResult As String

    strLS = Trim(strCome)

    strResult = ""

    j = Len(strLS)

    For i =  To j

        k = Mid(strLS, i, )

        If k <> " " And k <> "　" And VarType(k) <> vbNull And k <> vbNullString Then

            strResult = strResult & k

        End If

    Next

    mTrim = strResult

    Exit Function

mTrimErr:

    Err.Clear

    mTrim = strCome

End Function

'---以上代码可实现在EXCEL指定列（上面指定为B列）中录入日期内容时，任意可识别的日期都会被自动转换成标准日期值，并以日期值存储在单元格中
'---欢迎大家批评指正，如果发现错误，欢迎指正，如有不明子的地方，欢迎交流
'--QQ: 578652607

巴特西

通过VBA，当在EXCEL单元格中输入任意的日期格式时，都能自动转换为指定的标准格式的日期值

最新文章

热门文章