通過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("請確定此工作表中第幾列為日期型的數據！", "輸入數字", "2")
    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 = 0 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 = -1
k0:
    k = 0
    myDate = DateValue(strDATE)
    myDate = Format(myDate, "yyyy/m/d")
    TryChangeDate2 = myDate
    Exit Function
k1:
    k = 1
    myDate = DateValue(strDATE)
    myDate = Format(myDate, "yyyy/m/d")
    TryChangeDate2 = myDate
    Exit Function
TryChangeDate2ERR:
    Err.Clear
    If k = 0 Then
        nkkkk = Len(strK)
        Select Case nkkkk
            Case 4
                If InStr(1, strK, ".") = 0 And InStr(1, strK, ",") = 0 And InStr(1, strK, "/") = 0 And InStr(1, strK, "\") = 0 And InStr(1, strK, "-") = 0 Then
                    strDATE = Left(strK, 2) & "/" & Mid(strK, 3, 1) & "/" & Mid(strK, 4, 1)
                End If
            Case 5
                If InStr(1, strK, ".") = 0 And InStr(1, strK, ",") = 0 And InStr(1, strK, "/") = 0 And InStr(1, strK, "\") = 0 And InStr(1, strK, "-") = 0 Then
                    If Val(Mid(strK, 3, 1)) >= 3 Then
                        strDATE = Left(strK, 2) & "/" & Mid(strK, 3, 1) & "/" & Mid(strK, 4, 2)
                    Else
                        strDATE = Left(strK, 2) & "/" & Mid(strK, 3, 2) & "/" & Mid(strK, 5, 1)
                    End If
                End If
            Case 6
                If InStr(1, strK, ".") = 0 And InStr(1, strK, ",") = 0 And InStr(1, strK, "/") = 0 And InStr(1, strK, "\") = 0 And InStr(1, strK, "-") = 0 Then
                    If Left(strK, 1) = "1" Or Left(strK, 1) = "2" Then
                        strDATE = Left(strK, 4) & "/" & Mid(strK, 5, 1) & "/" & Mid(strK, 6, 1)
                    Else
                        strDATE = Left(strK, 2) & "/" & Mid(strK, 3, 2) & "/" & Mid(strK, 5, 2)
                    End If
                    GoTo theEnd
                End If
                    strDATE = Left(strK, 2) & "/" & Mid(strK, 4, 1) & "/" & Mid(strK, 6, 1)
            Case 7
                If InStr(1, strK, ".") = 0 And InStr(1, strK, ",") = 0 And InStr(1, strK, "/") = 0 And InStr(1, strK, "\") = 0 And InStr(1, strK, "-") = 0 Then
                    If Val(Mid(strK, 5, 1)) >= 3 Then
                        strDATE = Left(strK, 4) & "/" & Mid(strK, 5, 1) & "/" & Mid(strK, 6, 2)
                    Else
                        strDATE = Left(strK, 4) & "/" & Mid(strK, 5, 2) & "/" & Mid(strK, 7, 1)
                    End If
                Else
                    If Val(Mid(strK, 4, 1)) >= 3 Then
                        strDATE = Left(strK, 2) & "/" & Mid(strK, 4, 1) & "/" & Mid(strK, 6, 2)
                    Else
                        strDATE = Left(strK, 2) & "/" & Mid(strK, 4, 2) & "/" & Mid(strK, 7, 1)
                    End If
                End If
            Case 8
                If InStr(1, strK, ".") = 0 And InStr(1, strK, ",") = 0 And InStr(1, strK, "/") = 0 And InStr(1, strK, "\") = 0 And InStr(1, strK, "-") = 0 Then
                    strDATE = Left(strK, 4) & "/" & Mid(strK, 5, 2) & "/" & Mid(strK, 7, 2)
                Else
                    strDATE = Left(strK, 4) & "/" & Mid(strK, 6, 1) & "/" & Mid(strK, 8, 1)
                End If
            Case 9
                If Val(Mid(strK, 6, 1)) >= 3 Then
                    strDATE = Left(strK, 4) & "/" & Mid(strK, 6, 1) & "/" & Mid(strK, 8, 2)
                Else
                    strDATE = Left(strK, 4) & "/" & Mid(strK, 6, 2) & "/" & Mid(strK, 9, 1)
                End If
            Case 10
                strDATE = Left(strK, 4) & "/" & Mid(strK, 6, 2) & "/" & Mid(strK, 9, 2)
        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 * 1, strResult As String
    strLS = Trim(strCome)
    strResult = ""
    j = Len(strLS)
    For i = 1 To j
        k = Mid(strLS, i, 1)
        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