Excel geben Sie Daten mit oder ohne Schrägstriche ein

Question

Ich habe VBA-Code, um eine 6-stellige Zahl in ein Datum mit Schrägstrichen zu konvertieren ie 311215 wird 31/12/2015, aber ich möchte auch die Benutzer in der Lage sein, ein Datum mit dem einzugeben Schrägstriche auch.

Mit dem folgenden Code wird 31/12/15 23/04/1969 und 01/01/15 wird 20/04/2005 (?? - Antworten auf einer Postkarte für diese). von Format(.Text, "000000") auf die

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 

Ich muss auch die Validierung enthalten, so dass nur ein Datum in der Zelle eingegeben wird, wie dies in einer Reihe von anderen U-Boote verwendet wird

Answer 1

Ihre Zeichenfolge 31/12/15 wird als Datum und konvertiert ausgewertet interne Ganzzahldarstellung 42369 (das ist die Anzahl der Tage seit 1900). Ihr Format-Befehl entfernt die Schrägstriche nicht, sondern interpretiert den Wert als Ganzzahl-Zeichenfolge. Danach wandelt Ihr Code diese Nummer in 23/04/1969 um.

könnten Sie versuchen, Ihre

StrVal = Format(.Text, "000000")

von

StrVal = Replace(.Text, "/", "") zu ersetzen.

Answer 2

Dieser Code geht davon aus, dass D7 als Text vor Einträge alle Benutzer formatiert wurde:

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