输入日期无斜杠

我有时必须在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

输入日期无斜杠

回答

相关问题