0

因此，当分配给 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

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

4

2 回答 2

0

如果您选择数据类型，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
于 2017-09-27T19:03:14.100 回答
0

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

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

和一个测试：

日期正确吗？

于 2017-09-27T18:53:44.790 回答