2016-07-21 32 views
1

我有VBA代碼將6位數字轉換爲帶斜線的日期,即311215變爲31/12/2015,但我也希望用戶能夠輸入日期斜線也是如此。excel輸入帶或不帶斜槓的日期

使用下面的代碼,2015年12月31日成爲23/04/1969,01/01/15成爲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 

我還需要包括驗證,以便只有一個日期在單元格中輸入,因爲這是其他一些潛艇

的使用

回答

0

你的字符串31/12/15被評估爲日期,並轉換由Format(.Text, "000000")到內部整數表示42369(這是自1900年以來的天數)。您的Format命令不會刪除斜槓,而是將該值解釋爲整數字符串。之後,您的代碼將此號碼轉換爲23/04/1969

你可以試試你的

StrVal = Format(.Text, "000000")

通過

StrVal = Replace(.Text, "/", "")更換。

0

此代碼假定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