日期自动反转 VBA Excel

Question

所以，当分配给 Date 变量时，我遇到了一些问题，这些日期在 VBA 中反转。它比听起来简单，但它真的让我很烦。

代码：

Dim InsertedDate as Date

On Error Resume Next

InsertedDate = Me.BoxDate.Value

If InsertedDate = 0 Then

     'Do Something

Else

     'Do Something Different

End If

所以让我们假设用户输入了一个类似的值

12/18/2017

我是巴西人，这意味着用户输入的是第 18 个月的第 12 天。由于一年中没有第 18 个月，因此用户不应该输入该日期并且 InsertedDate 应该等于 0，对吗？或不？我的意思是，我不太确定 Excel 的工作日期。

无论如何，发生的事情是：Excel自动将日期反转为

18/12/2017       'InsertedDate Value

而不是 InsertedDate

12/18/2017       'InsertedDate Value

然后代码转到“做一些不同的事情”。那么，我该如何解决呢？请注意，我没有将变量值分配给任何东西。将值分配给变量时，会自动发生反转过程。我已经试过了

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

和

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

我尝试将值转换为其他变量和东西。所以，我迷路了。如果有人可以帮助我，我将非常感激。提前谢谢你。

Answer 1

如果您选择数据类型为Date，它将自动将日期转换为美国格式。
我的建议是检查用户的日期格式并假设他使用相同（这不是最安全的假设）：

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

但它假定用户已使用“/”作为分隔符 - 并且可能有很多其他情况。您可以改用日期选择器或验证日期的函数。

编辑： 实际上，这是我使用的函数的变体及其在您的代码中的实现：

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

Answer 2

我只是想出了一种方法，使其以最困难的方式实现，即提取每个元素并进行比较。

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

尝试使用IsDate()函数，但它反转了日期，即使之前使用了"dd/mm/yyyy"的格式。

编辑：

UDF 分割日期

如果用户输入另一种格式“d/m/yy”，下面的代码将正确。其中EXTRACTELEMENT函数将String按/分割并获取元素。

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

所以要使用UDF，如果日期是diamesano = "2/5/14"

• 日期将是 EXTRACTELEMENT(CStr(diamesano), 1, "/")，其中 1 是第一个元素，即值为 2
• 月份将是 EXTRACTELEMENT(CStr(diamesano), 2, "/")，其中 2 是第二个元素，即值为 5
• 年份将是 EXTRACTELEMENT(CStr(diamesano), 3, "/")，其中 3 是第三个元素，即值为 14

使用 UDF 和检查日期的代码

代码更改为：

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

创建UDF检查日期是否正确

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

还有一个测试：