輸入日期無斜槓

我有時必須在Excel電子表格中輸入大量日期。不得不輸入斜槓會使事情減少很多，並使得該過程更容易出錯。在許多數據庫程序中，可以僅使用數字輸入日期。輸入日期無斜槓

我已經寫了SheetChange事件處理程序，可以讓進入格式化爲日期的單元格的日期時，我做這件事，但如果我從一個位置複製日期到另一個失敗。如果我可以確定一個條目何時被複制而不是輸入，我可以分別處理這兩種情況，但我還沒有能夠確定這一點。

這裏是我的代碼，但是你看它之前，要知道，最後一節處理自動插入一個小數點，它似乎是工作確定。最後，我添加了一些變量（sValue，sValue2等），使我更容易跟蹤數據。

Option Explicit 
Private WithEvents App As Application 

Private Sub Class_Initialize() 
    Set App = Application 
End Sub 
Private Sub App_SheetChange(ByVal Sh As Object, ByVal Source As Range) 
Dim s As String 
Dim sFormat As String 
Dim sValue As String 
Dim sValue2 As String 
Dim sFormula As String 
Dim sText As String 
Dim iPos As Integer 
Dim sDate As String 
    On Error GoTo ErrHandler: 
    If Source.Cells.Count > 1 Then 
    Exit Sub 
    End If 
    If InStr(Source.Formula, "=") > 0 Then 
    Exit Sub 
    End If 
    sFormat = Source.NumberFormat 
    sFormula = Source.Formula 
    sText = Source.Text 
    sValue2 = Source.Value2 
    sValue = Source.Value 
    iPos = InStr(sFormat, ";") 
    If iPos > 0 Then sFormat = Left(sFormat, iPos - 1) 
    If InStr("m/d/yy|m/d/yyyy|mm/dd/yy|mm/dd/yyyy|mm/dd/yy", sFormat) > 0 Then 
    If IsDate(Source.Value2) Then 
     Exit Sub 
    End If 
    If IsNumeric(Source.Value2) Then 
     s = CStr(Source.Value2) 
     If Len(s) = 5 Then s = "0" & s 
     If Len(s) = 6 Then 
     s = Left(s, 2) & "/" & Mid(s, 3, 2) & "/" & Right(s, 2) 
     App.EnableEvents = False 
     If IsDate(s) Then Source.Value = s 'else source is unchanged 
     App.EnableEvents = True 
     End If 
     If Len(s) = 7 Then s = "0" & s 
     If Len(s) = 8 Then 
     s = Left(s, 2) & "/" & Mid(s, 3, 2) & "/" & Right(s, 4) 
     App.EnableEvents = False 
     If IsDate(s) Then Source.Value = s 'else source is unchanged 
     App.EnableEvents = True 
     End If 
    End If 
    End If 
    If InStr(sFormat, "0.00") > 0 Then 
    If IsNumeric(Source.Formula) Then 
     s = Source.Formula 
     If InStr(".", s) = 0 Then 
     s = Left(s, Len(s) - 2) & "." & Right(s, 2) 
     App.EnableEvents = False 
     Source.Formula = CDbl(s) 
     App.EnableEvents = True 
     End If 
    End If 
    End If 
ErrHandler: 
    App.EnableEvents = True 
End Sub

您是否知道我如何才能讓它適用於複製日期以及編輯日期？謝謝你的幫助。

來源

2011-09-10 jrodenhi

您不必調用'App.EnableEvents = TRUE;在樹的每一個分支，因爲你擁有它到底。順便說一句，你最好添加錯誤處理程序之前退出子（和'App.EnableEvents = TRUE'太） – JMax

這可能是最簡單的設置日期格式點，而不是在控制面板中斜線（區域和語言設置）。至少點在數字鍵盤上。 – Fionnuala

實際上，事件Worksheet_Change被稱爲當複製/粘貼，所以它應該工作。

與剛剛測試：

Private Sub Worksheet_Change(ByVal Target As Range) 
    MsgBox "Test" 
End Sub

來源

2011-09-10 06:55:31 JMax

輸入日期無斜槓

回答

相關問題