Question

我知道我们可以在表格中使用函数 Date 插入日期。但是对于某些日期（例如回历沙姆西和回历历史）等，这是不可能且困难的。所以我写了一个与文本框一起工作的代码。但是我认为我编写的代码可以更简单。您有解决方案以使其更简单吗？例如：检查斜线或防止出现双重错误消息，以显示月和日错误。

预先感谢做出回应的朋友。

Private Sub TextBox1_Change()
    'To check the slash in the correct place
    If Mid(TextBox1, 1) = "/" Or Mid(TextBox1, 2) = "/" Or Mid(TextBox1, 3) = "/" Or Mid(TextBox1, 4) = "/" Or Mid(TextBox1, 6) = "/" Or Mid(TextBox1, 7) = "/" Or Mid(TextBox1, 9) = "/" Or Mid(TextBox1, 10) = "/" Then
        MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
        SendKeys ("{BACKSPACE}")
    End If
    'Insert the slash automatically
    If TextBox1.TextLength = 8 Then
        Me.TextBox1.Value = Format(Me.TextBox1.Value, "0000/00/00")
    End If

    'Year Error!
    If Mid(TextBox1, 4) = 0 Then
        MsgBox "Year Error!" & vbNewLine & "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
        With TextBox1
            .SelStart = 0
            .SelLength = Len(.Text)
        End With
        Exit Sub
    End If
    'Month Error!
    If TextBox1.TextLength = 10 Then
        If Mid(TextBox1.Value, 6, 2) = 0 Or Mid(TextBox1.Value, 6, 2) > 12 Then
            MsgBox "Month Error!" & vbNewLine & "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
            With TextBox1
                .SelStart = 5
                .SelLength = 2
                '.SelText = ""
            End With
            Exit Sub
        End If
    End If
    'Day Error!
    If TextBox1.TextLength = 10 Then
        If Mid(TextBox1.Value, 9, 2) = 0 Or Mid(TextBox1.Value, 9, 2) > 31 Then
            MsgBox "Day Error!" & vbNewLine & "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
            With TextBox1
                .SelStart = 8
                .SelLength = 2
            End With
            Exit Sub
        End If
    End If
End Sub

Private Sub textbox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    'Accept only number and slash
    If Not Chr(KeyAscii) Like "[0-9,/ ]" Then
        KeyAscii = 0
        MsgBox "Only Numbers Allowed!" & vbNewLine & "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
        With TextBox1
            .SetFocus
            Exit Sub
        End With
    End If
End Sub

Answer 1

我对您正在处理的日历表单还不够熟悉，所以请理解我的基于西式日历的示例。

您执行某些错误检查的方式会稍微掩盖您要检查的值。例如，

If Mid(TextBox1.Value, 6, 2) = 0 Or Mid(TextBox1.Value, 6, 2) > 12 Then

是完全有效的检查，但是您过度使用了Mid函数。一种建议是解析日期字符串，然后将子字符串拉出您要查找的值。如：

Dim month As Long
month = CLng(Mid$(TextBox1.Value, 6, 2))
If (month = 0) Or (month > 12) Then

这更直观。是的，它创建了一个额外的变量，但是它使您的代码更具可读性。

这是我的代码（未经测试）版本，这是如何完成代码的另一个示例。注意，我将错误检查分为一个单独的函数，因为它涉及更多。（这样就不会使主例程变得混乱。）

编辑：答案已更新并经过测试。从TextBox1_Change更改了事件代码，现在捕获了两个不同的事件：LostFocus和KeyDown，以便在用户单击文本框或键入 Enter <时启动验证。 / kbd>，而在文本框中。

Option Explicit

Private Enum ValidationError
    LengthError
    FormatError
    YearError
    MonthError
    DayError
    NoErrors
End Enum

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
                             ByVal Shift As Integer)
    If KeyCode = Asc(vbCr) Then
        ValidateDate
    End If
End Sub

Private Sub TextBox1_LostFocus()
    ValidateDate
End Sub

Private Sub ValidateDate()
    With TextBox1
        Select Case InputIsValidated(.text)
            Case LengthError
                MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD with only numbers and a '/'"
            Case FormatError
                MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD with only numbers and a '/'"
            Case YearError
                .SelStart = 0
                .SelLength = 4
                MsgBox "Invalid Year. Must be between 2015 and 2020"
            Case MonthError
                .SelStart = 5
                .SelLength = 2
                MsgBox "Invalid Month. Must be between 1 and 12"
            Case DayError
                .SelStart = 7
                .SelLength = 2
                MsgBox "Invalid Day. Must be between 1 and 31"
            Case NoErrors
                '--- nothing to do, it's good!
                MsgBox "It's good!"
        End Select
    End With
End Sub

Private Function InputIsValidated(ByRef text As String) As ValidationError
    '--- perform all sorts of checks to validate the input
    '    before any processing
    '--- MUST be the correct length
    If (Len(text) <> 8) And (Len(text) <> 10) Then
        InputIsValidated = LengthError
        Exit Function
    End If

    '--- check if all characters are numbers
    Dim onlyNumbers As String
    onlyNumbers = Replace(text, "/", "")
    If Not IsNumeric(onlyNumbers) Then
        InputIsValidated = FormatError
        Exit Function
    End If

    Dim yyyy As Long
    Dim mm As Long
    Dim dd As Long
    yyyy = Left$(onlyNumbers, 4)
    mm = Mid$(onlyNumbers, 5, 2)
    dd = Right$(onlyNumbers, 2)

    '--- only checks if the numbers are in range
    '    you can make this more involved if you want to check
    '    if, for example, the day for February is between 1-28
    If (yyyy < 2015) Or (yyyy > 2020) Then
        InputIsValidated = YearError
        Exit Function
    End If

    If (mm < 1) Or (mm > 12) Then
        InputIsValidated = MonthError
        Exit Function
    End If

    If (dd < 1) Or (dd > 31) Then
        InputIsValidated = DayError
        Exit Function
    End If

    text = onlyNumbers
    InputIsValidated = NoErrors
End Function

Answer 2

由于@PeterT，我在@PeterT的指导下更正了代码，并将其提供给所有感兴趣的人。 享受它。

Option Explicit

Private Enum ValidationError
    LengthError
    FormatError
    YearError
    MonthError
    DayError
    NoErrors
End Enum

Private Sub TextBox1_Change()
    'To check the slash in the correct place
    If TextBox1.TextLength = 10 Then
        If InStr(Left(TextBox1, 4), "/") Or InStr(Mid(TextBox1, 6, 2), "/") Or InStr(Mid(TextBox1, 9, 2), "/") <> 0 Then
            MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
            With TextBox1
            .SelStart = 0
            .SelLength = Len(.text)
            End With
        End If
    End If
    'Insert the slash automatically
    If TextBox1.TextLength = 8 Then
        If InStr(TextBox1, "/") Then
        'nothing
        Else
            Me.TextBox1.Value = Format(Me.TextBox1.Value, "0000/00/00")
        End If
    End If
End Sub

Private Sub textbox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    'Accept only number and slash
    If Not Chr(KeyAscii) Like "[0-9,/ ]" Then
        KeyAscii = 0
        MsgBox "Only Numbers Allowed!" & vbNewLine & "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
    End If
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = Asc(vbCr) Then
        ValidateDate
    End If
End Sub

Private Sub TextBox1_LostFocus()
    ValidateDate
End Sub

Private Sub ValidateDate()
    With TextBox1
        Select Case InputIsValidated(.text)
            Case LengthError
                MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD with only numbers and a '/'"
            Case FormatError
                MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD with only numbers and a '/'"
            Case YearError
                .SelStart = 0
                .SelLength = 4
                MsgBox "Invalid Year. Must be between 2015 and 2020"
            Case MonthError
                .SelStart = 5
                .SelLength = 2
                MsgBox "Invalid Month. Must be between 1 and 12"
            Case DayError
                .SelStart = 8
                .SelLength = 2
                MsgBox "Invalid Day. Must be between 1 and 31"
            Case NoErrors
                '--- nothing to do, it's good!
                MsgBox "It's good!"
        End Select
    End With
End Sub

Private Function InputIsValidated(ByRef text As String) As ValidationError
    '--- perform all sorts of checks to validate the input
    '    before any processing
    '--- MUST be the correct length
    If InStr(TextBox1, "/") And TextBox1.TextLength < 10 Then
        InputIsValidated = FormatError
        Exit Function
    End If

    Dim yyyy As Long
    Dim mm As Long
    Dim dd As Long
    yyyy = Left$(TextBox1, 4)
    mm = Mid$(TextBox1, 6, 2)
    dd = Right$(TextBox1, 2)

    '--- only checks if the numbers are in range
    '    you can make this more involved if you want to check
    '    if, for example, the day for February is between 1-28
    If (yyyy < 2015) Or (yyyy > 2020) Then
        InputIsValidated = YearError
        Exit Function
    End If

    If (mm < 1) Or (mm > 12) Then
        InputIsValidated = MonthError
        Exit Function
    End If

    If (dd < 1) Or (dd > 31) Then
        InputIsValidated = DayError
        Exit Function
    End If

    text = TextBox1
    InputIsValidated = NoErrors
End Function

在文本框中插入日期-VBA

2 个答案: