Date Automatically Reversing VBA Excel

问题

So, I'm having some problems with dates that are reversing themselves in VBA when assigned to a Date variable. It's simpler than it sounds, but it's really bugging me.

Code:

Dim InsertedDate as Date

On Error Resume Next

InsertedDate = Me.BoxDate.Value

If InsertedDate = 0 Then

     'Do Something

Else

     'Do Something Different

End If

So let's assume that user types a value like

12/18/2017

I'm brazilian, so that means the user typed the 12th day of the 18th month. Since there's no 18th month in the year, the user shouldn't be able to type that date and InsertedDate should be equal to 0, right? Or not? I mean, I'm not really sure how Excel work dates.

Anyway, what happens is: Excel automatically reverses the date to

18/12/2017       'InsertedDate Value

instead of InsertedDate being

12/18/2017       'InsertedDate Value

And the code goes to 'Do Something Different. So, how do I solve this? Notice that I haven't assigned the variable value to anything. The process of reversion happens automatically when assigning the value to the variable. I've already tried

Format(InsertedDate, "dd/mm/yyyy")    'Did not work

and

InsertedDate = CDate(Me.BoxDate.Value)  'Did not work

and I tried converting the values in other variables and stuff. So, I'm lost. If anyone could help me, I'd be extremely grateful. Thank you in advance.

回答1:

If you choose data type as Date it will automatically convert dates to american format.
My suggestion is to check the date format of the user and assume he uses the same (and it is not the safest assumption):

If Application.International(xlMDY) then
     InsertedDate = Me.BoxDate.Value
Else:
     Arr = Split(Me.BoxDate.Value,"/")
     InsertedDate = DateSerial(Arr(2),Arr(1),Arr(0))
End if

But it assumes that user has used "/" as a delimite - and there could be a lot of other scenarios. You can use a date picker instead or a function that will validate the date.

EDIT: Actually here is a variation of function I use and its implementation in your code:

Sub TestDate()
If ConformDate(Me.BoxDate.Value) = "" Then
    MsgBox "Invalid Date!"
Else
    MsgBox "" & ConformDate(Me.BoxDate.Value) & " is a valid date"
End If
End Sub

Function ConformDate(DataToTransform As String) As String

Dim DTT         As String
Dim delim       As String
Dim i           As Integer
DTT = DataToTransform

DTT = Trim(DTT)
With CreateObject("VBScript.RegExp")
    .Pattern = "\s+"
    .Global = True
    DTT = .Replace(DTT, " ")
End With
Select Case True
   Case (DTT Like "*/*/*")
        delim = "/"
   Case (DTT Like "*-*-*")
        delim = "-"
   Case (DTT Like "*.*.*")
        delim = "."
   Case (DTT Like "* * *")
        delim = " "
   Case Else
        ConformDate = ""
        Exit Function
End Select
Arr = Split(DTT, delim)
If UBound(Arr) < 2 Then
    ConformDate = ""
    Exit Function
End If
Dim Arrm(2) As String
If Application.International(xlMDY) Then
    Arrm(0) = Arr(0)
    Arrm(1) = Arr(1)
    Arrm(2) = Arr(2)
Else
    Arrm(0) = Arr(1)
    Arrm(1) = Arr(0)
    Arrm(2) = Arr(2)
End If
For i = LBound(Arrm) To UBound(Arrm)
    If Not IsNumeric(Arrm(i)) Then
        ConformDate = ""
        Exit Function
    End If
Select Case i
        Case 0
            ' Month
            If Len(Arrm(i)) < 1 Or Len(Arrm(i)) > 2 Then
                ConformDate = ""
                Exit Function
            End If
            If Left(Arrm(i), 1) = "0" And Len(Arrm(i)) = 1 Then
                ConformDate = ""
                Exit Function
            End If
            If Left(Arrm(i), 1) = "0" Then Arr(i) = Right(Arrm(i), 1)
            If Arrm(i) > 12 Then
                ConformDate = ""
                Exit Function
            End If
        Case 1
            ' Day
            If Len(Arrm(i)) < 1 Or Len(Arrm(i)) > 2 Then
                ConformDate = ""
                Exit Function
            End If

            If Left(Arrm(i), 1) = "0" And Len(Arrm(i)) = 1 Then
                ConformDate = ""
                Exit Function
            End If
            If Left(Arrm(i), 1) = "0" Then Arrm(i) = Right(Arrm(i), 1)
                If Arrm(i) > 31 Then
                ConformDate = ""
                Exit Function
            End If
            Case 2
            ' Year
            If Not (Len(Arrm(i)) = 2 Or Len(Arrm(i)) = 4) Then
                ConformDate = ""
                Exit Function
            End If
            If Len(Arrm(i)) = 2 Then Arrm(i) = Left(Year(Date), 2) & CStr(Arrm(i))
 End Select
Next

If Application.International(xlMDY) Then
    ConformDate = Format((DateSerial(CInt(Arrm(2)), CInt(Arrm(0)), CInt(Arrm(1)))), "dd/mm/yyyy")
Else
     ConformDate = Format((DateSerial(CInt(Arrm(2)), CInt(Arrm(1)), CInt(Arrm(0)))), "dd/mm/yyyy")
End If
End Function

回答2:

I just could think of a way to make it on the hardest way, which is extracting each element and comparing.

diamesano = Me.BoxDate.Value
'diamesano = "12/18/2017"

    dia = CLng(Left(diamesano, 2))
    mes = CLng(Left(Mid(diamesano, 4), 2))
    ano = CLng(Right(diamesano, 4)) 'Assuming year with 4 digits, otherwise some tweaks are necessary
    Debug.Print "day: " & dia & " month: " & mes & " Year: " & ano

    date_error = 0
    If mes >= 1 And mes <= 12 Then 'Check if month is ok
        mesAno = (Right(diamesano, 7))
        DiasNoMes = Day(DateSerial(Year(mesAno), Month(mesAno) + 1, 0))
        If dia >= 1 And dia <= DiasNoMes Then 'Check the amount of days on this month and if is in range
            Debug.Print "OK"
           'Do something because the Date is valid!
        Else
            date_error = 1
        End If
    Else
            date_error = 1
    End If

If date_error = 1 Then
         Debug.Print "NOK"
        'Date is invalid =P
End If

Tried to use IsDate() function, but it reversed the date, even if formatting "dd/mm/yyyy" is used before.

Edit:

UDF to split the date

If the user input another format as "d/m/yy", the code below will correct. In which the function EXTRACTELEMENT will split the String by / and get the elements.

Function EXTRACTELEMENT(Txt As String, n, Separator As String) As String
 On Error GoTo ErrHandler:
 EXTRACTELEMENT = Split(Application.Trim(Mid(Txt, 1)), Separator)(n - 1)
 Exit Function
ErrHandler:
    ' error handling code
    MsgBox "ERROR: Verify if the data exists, example if the separator is correct."
    On Error GoTo 0
End Function

So to use the UDF, if the date is diamesano = "2/5/14"

• the day will be EXTRACTELEMENT(CStr(diamesano), 1, "/") where 1 is the 1st element that is the value 2
• the month will be EXTRACTELEMENT(CStr(diamesano), 2, "/") where 2 is the 2nd element that is the value 5
• the year will be EXTRACTELEMENT(CStr(diamesano), 3, "/") where 3 is the 3rd element that is the value 14

Code to use the UDF and check dates

And the code changes to:

diamesano = "12/18/2017"

    dia = CLng(EXTRACTELEMENT(CStr(diamesano), 1, "/"))
    mes = CLng(EXTRACTELEMENT(CStr(diamesano), 2, "/"))
    ano = CLng(EXTRACTELEMENT(CStr(diamesano), 3, "/"))
    Debug.Print "day: " & dia & " month: " & mes & " Year: " & ano

    date_error = 0
    If mes >= 1 And mes <= 12 Then 'Check if month is ok
        mesAno = mes & "/" & ano
        DiasNoMes = Day(DateSerial(Year(mesAno), Month(mesAno) + 1, 0))
        If dia >= 1 And dia <= DiasNoMes Then 'Check the amount of days on this month and if is in range
            Debug.Print "OK"
           'Do something because the Date is valid!
        Else
           date_error = 1
        End If
    Else
        date_error = 1
    End If

    If date_error = 1 Then
             Debug.Print "NOK"
            'Date is invalid =P
    End If

Create UDF to check if the Date is right

Function IsDateRight(diamesano) As String
    On Error GoTo ErrHandler:
    dia = CLng(Split(Application.Trim(Mid(CStr(diamesano), 1)), "/")(0))
    mes = CLng(Split(Application.Trim(Mid(CStr(diamesano), 1)), "/")(1))
    ano = CLng(Split(Application.Trim(Mid(CStr(diamesano), 1)), "/")(2))

    'Debug.Print "day: " & dia & " month: " & mes & " Year: " & ano

    date_error = 0
    If mes >= 1 And mes <= 12 Then 'Check if month is ok
        mesAno = mes & "/" & ano
        DiasNoMes = Day(DateSerial(Year(mesAno), Month(mesAno) + 1, 0))
        If dia >= 1 And dia <= DiasNoMes Then 'Check the amount of days on this month and if is in range
            IsDateRight = "Yes"
           'Do something because the Date is valid!
        Else
           date_error = 1
        End If
    Else
        date_error = 1
    End If

    If date_error = 1 Then
             IsDateRight = "No"
            'Date is invalid =P
    End If
    Exit Function
    ErrHandler:
    ' error handling code
    MsgBox "ERROR: Verify if the data exists, example if the separator is correct."
    On Error GoTo 0
End Function

And a test:

来源：https://stackoverflow.com/questions/46454663/date-automatically-reversing-vba-excel