日期自动反转 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

我只是想到了一个最难的方法，即提取每个元素并进行比较。

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 将字符串按 / 拆分并获取元素。

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

还有一个测试：

Answer 2

如果您选择 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

日期自动反转 VBA Excel

Date Automatically Reversing VBA Excel

excel

vba

reversing

date

编辑：

UDF 拆分日期

使用 UDF 和检查日期的代码

创建 UDF 以检查日期是否正确