[已解决]光标离开后，判断是否输入的是日期， 不知怎样写，请帮忙

一成不变变

光标离开后，判断是否输入的是日期， 不知怎样写，请帮忙
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

            If                                         Then
                    MsgBox "你输入的不是日期格式，请重新输入"
         End If
End Sub

最佳答案

月排行榜 / 总排行榜

yorkchenshunan

2015-12-4 09:50

一成不变变 发表于 2015-12-4 09:41
如果输入错误，显示显示框并清空输入内容，不知怎样加入，请帮忙

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim a
   
3.     If Target.Count = 1 Then
   
4.         a = Target.Value
   
5.         If TypeName(a) <> "Date" Then
   
6.             MsgBox "你输入的不是日期格式，请重新输入"
   
7.             Application.EnableEvents = False
   
8.             Target.ClearContents
   
9.             Application.EnableEvents = True
   
10.         End If
    
11.     End If
    
12. End Sub

复制代码

跳转到最佳答案楼层

yorkchenshunan

附件

一成不变变

yorkchenshunan 发表于 2015-12-3 16:23
附件

如果输入错误，显示显示框并清空输入内容，不知怎样加入，请帮忙


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a
    If Target.Count = 1 Then
        a = Target.Value
        If TypeName(a) <> "Date" Then
            MsgBox "你输入的不是日期格式，请重新输入"
             Target.ClearContents   清空内容
        End If
    End If
End Sub

一成不变变

yorkchenshunan 发表于 2015-12-3 16:23
附件

如果输入错误，显示显示框并清空输入内容，不知怎样加入，请帮忙


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a
    If Target.Count = 1 Then
        a = Target.Value
        If TypeName(a) <> "Date" Then
            MsgBox "你输入的不是日期格式，请重新输入"
             Target.ClearContents   清空内容
        End If
    End If
End Sub

yorkchenshunan

一成不变变 发表于 2015-12-4 09:41
如果输入错误，显示显示框并清空输入内容，不知怎样加入，请帮忙

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim a
   
3.     If Target.Count = 1 Then
   
4.         a = Target.Value
   
5.         If TypeName(a) <> "Date" Then
   
6.             MsgBox "你输入的不是日期格式，请重新输入"
   
7.             Application.EnableEvents = False
   
8.             Target.ClearContents
   
9.             Application.EnableEvents = True
   
10.         End If
    
11.     End If
    
12. End Sub

复制代码