Question

我有VBA代码将6位数字转换为带斜线的日期，即311215变为2015年12月31日，但我也希望用户能够输入带斜杠的日期。

使用下面的代码，2015年12月31日成为23/04/1969，2015年1月1日成为20/04/2005（?? - 明信片上的答案）。

Private Sub worksheet_change(ByVal target As Range)

Dim StrVal As String
Dim dDate As Date

If target.Cells.Count > 1 Then Exit Sub

If Intersect(target, Range("D7")) Is Nothing Then Exit Sub

With target

    StrVal = Format(.Text, "000000")

      If IsNumeric(StrVal) And Len(StrVal) = 6 Then

         Application.EnableEvents = False

        If Application.International(xlDateOrder) = 1 Then 'dd/mm/yy

            dDate = DateValue(Left(StrVal, 2) & "/" & Mid(StrVal, 3, 2) & "/" & Right(StrVal, 2))

        Else 'mm/dd/yy

            dDate = DateValue(Mid(StrVal, 3, 2) & "/" & Left(StrVal, 2) & "/" & Right(StrVal, 2))

        End If

        .NumberFormat = "dd/mm/yyyy"

        .Value = CDate(DateSerial(Year(dDate), Month(dDate), Day(dDate)))

      End If

End With

Application.EnableEvents = True

End Sub

我还需要包含验证，以便只在单元格中输入日期，因为这在许多其他潜艇中使用

Answer 1

您的字符串script将被评估为日期，并由31/12/15转换为内部整数表示Format(.Text, "000000")（这是自1900年以来的天数）。您的42369命令不会删除斜杠，但会将该值解释为整数字符串。之后，您的代码会将此数字转换为Format。

您可以尝试替换

23/04/1969

通过

StrVal = Format(.Text, "000000")。

Answer 2

此代码假定 D7 已格式化为文字任何用户条目：

Private Sub worksheet_change(ByVal target As Range)
    Dim StrVal As String
    Dim dDate As Date

    If target.Cells.Count > 1 Then Exit Sub
    If Intersect(target, Range("D7")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    With target
        StrVal = .Text
        If IsNumeric(StrVal) And Len(StrVal) = 6 Then
            If Application.International(xlDateOrder) = 1 Then 'dd/mm/yy
                dDate = DateValue(Left(StrVal, 2) & "/" & Mid(StrVal, 3, 2) & "/" & Right(StrVal, 2))
            Else 'mm/dd/yy
                dDate = DateValue(Mid(StrVal, 3, 2) & "/" & Left(StrVal, 2) & "/" & Right(StrVal, 2))
            End If
            .NumberFormat = "dd/mm/yyyy"
            .Value = dDate
        Else
            ary = Split(StrVal, "/")

            If Len(ary(2)) = 2 Then ary(2) = "20" & ary(2) 'fix the year if necessary

            If Application.International(xlDateOrder) = 1 Then 'dd/mm/yy
                dDate = DateValue(ary(2) & "/" & ary(1) & "/" & ary(0))
            Else 'mm/dd/yy
                dDate = DateValue(ary(2) & "/" & ary(0) & "/" & ary(1))
            End If
            .NumberFormat = "dd/mm/yyyy"
            .Value = dDate
        End If
    End With
    Application.EnableEvents = True
End Sub

excel输入带或不带斜线的日期

2 个答案: