这个好办!
Function InputDate(xText As Variant)
On Error Resume Next
Dim a, B, C As String
If Len(xText.Text) = 1 Then
If Left((xText.Text), 1) <> "1" And Left((xText.Text), 1) <> "2" Then
xText.Text = ""
Exit Sub
End If
End If
If Len(xText.Text) = 2 Or Len(xText.Text) = 3 Or Len(xText.Text) = 4 Then
If Right((xText.Text), 1) <> "0" And Right((xText.Text), 1) <> "1" And _
Right((xText.Text), 1) <> "2" And Right((xText.Text), 1) <> "3" And _
Right((xText.Text), 1) <> "4" And Right((xText.Text), 1) <> "5" And _
Right((xText.Text), 1) <> "6" And Right((xText.Text), 1) <> "7" And _
Right((xText.Text), 1) <> "8" And Right((xText.Text), 1) <> "9" Then
xText.Text = Left((xText.Text), Len(xText.Text) - 1)
xText.SelStart = Len(xText.Text)
End If
End If
If Len(xText.Text) = 4 Then
xText.Text = xText.Text + "-"
xText.SelStart = Len(xText.Text)
End If
Rem ---------------------------------------------------------------------------
Rem 月份输入的控制
Rem ---------------------------------------------------------------------------
If Len(xText.Text) = 6 Then
If Right((xText.Text), 1) <> "0" And Right((xText.Text), 1) <> "1" Then
If Right((xText.Text), 1) = "2" Or Right((xText.Text), 1) = "3" Or _
Right((xText.Text), 1) = "4" Or Right((xText.Text), 1) = "5" Or _
Right((xText.Text), 1) = "6" Or Right((xText.Text), 1) = "7" Or _
Right((xText.Text), 1) = "8" Or Right((xText.Text), 1) = "9" Then
a = Right((xText.Text), 1)
xText.Text = Left((xText.Text), 5) + "0" + a + "-"
xText.SelStart = Len(xText.Text)
Else
xText.Text = Left((xText.Text), Len(xText.Text) - 1)
xText.SelStart = Len(xText.Text)
End If
End If
End If
If Len(xText.Text) = 7 Then
If Left(Right(xText.Text, 2), 1) = "0" Then
If Right((xText.Text), 1) <> "1" And Right((xText.Text), 1) <> "2" And _
Right((xText.Text), 1) <> "3" And Right((xText.Text), 1) <> "4" And _
Right((xText.Text), 1) <> "5" And Right((xText.Text), 1) <> "6" And _
Right((xText.Text), 1) <> "7" And Right((xText.Text), 1) <> "8" And _
Right((xText.Text), 1) <> "9" Then
xText.Text = Left((xText.Text), Len(xText.Text) - 1)
xText.SelStart = Len(xText.Text)
Else
xText.Text = xText.Text + "-"
xText.SelStart = Len(xText.Text)
Exit Sub
End If
End If
If Left(Right((xText.Text), 2), 1) = "1" Then
If Right((xText.Text), 1) <> "0" And Right((xText.Text), 1) <> "1" And Right((xText.Text), 1) <> "2" Then
xText.Text = Left((xText.Text), Len(xText.Text) - 1)
xText.SelStart = Len(xText.Text)
Else
xText.Text = xText.Text + "-"
xText.SelStart = Len(xText.Text)
End If
End If
End If
If Len(xText.Text) = 9 Then
If Right((xText.Text), 1) <> "0" And Right((xText.Text), 1) <> "1" And _
Right((xText.Text), 1) <> "2" And Right((xText.Text), 1) <> "3" Then
If Right((xText.Text), 1) = "4" Or Right((xText.Text), 1) = "5" Or _
Right((xText.Text), 1) = "6" Or Right((xText.Text), 1) = "7" Or _
Right((xText.Text), 1) = "8" Or Right((xText.Text), 1) = "9" Then
a = Right((xText.Text), 1)
xText.Text = Left((xText.Text), 8) + "0" + a
xText.SelStart = Len(xText.Text)
Else
xText.Text = Left((xText.Text), Len(xText.Text) - 1)
xText.SelStart = Len(xText.Text)
End If
End If
End If
If Len(xText.Text) = 10 Then
B = Left(Right(xText.Text, 5), 2)
C = Left(xText.Text, 4)
If Right((xText.Text), 1) <> "0" And Right((xText.Text), 1) <> "1" And _
Right((xText.Text), 1) <> "2" And Right((xText.Text), 1) <> "3" And _
Right((xText.Text), 1) <> "4" And Right((xText.Text), 1) <> "5" And _
Right((xText.Text), 1) <> "6" And Right((xText.Text), 1) <> "7" And _
Right((xText.Text), 1) <> "8" And Right((xText.Text), 1) <> "9" Then
xText.Text = Left((xText.Text), Len(xText.Text) - 1)
xText.SelStart = Len(xText.Text)
End If
If Right(xText.Text, 2) = "00" Then
xText.Text = Left((xText.Text), Len(xText.Text) - 2)
xText.SelStart = Len(xText.Text)
End If
If (B = "01" And Val(Right(xText.Text, 2)) > 31) Or _
(B = "03" And Val(Right(xText.Text, 2)) > 31) Or _
(B = "05" And Val(Right(xText.Text, 2)) > 31) Or _
(B = "07" And Val(Right(xText.Text, 2)) > 31) Or _
(B = "08" And Val(Right(xText.Text, 2)) > 31) Or _
(B = "10" And Val(Right(xText.Text, 2)) > 31) Or _
(B = "12" And Val(Right(xText.Text, 2)) > 31) Then
xText.Text = Left((xText.Text), Len(xText.Text) - 2)
xText.SelStart = Len(xText.Text)
End If
If (B = "04" And Val(Right(xText.Text, 2)) > 30) Or _
(B = "06" And Val(Right(xText.Text, 2)) > 30) Or _
(B = "09" And Val(Right(xText.Text, 2)) > 30) Or _
(B = "11" And Val(Right(xText.Text, 2)) > 30) Then
xText.Text = Left((xText.Text), Len(xText.Text) - 2)
xText.SelStart = Len(xText.Text)
End If
If B = "02" Then
If Val(C) Mod 4 <> 0 And Val(Right(xText.Text, 2)) > 28 Then
xText.Text = Left((xText.Text), Len(xText.Text) - 2)
xText.SelStart = Len(xText.Text)
End If
If Val(C) Mod 4 = 0 And Val(Right(xText.Text, 2)) > 29 Then
xText.Text = Left((xText.Text), Len(xText.Text) - 2)
xText.SelStart = Len(xText.Text)
End If
End If
End If
If Len(xText.Text) = 11 Then
xText.Text = Left((xText.Text), Len(xText.Text) - 2)
xText.SelStart = Len(xText.Text)
End If
End Sub
右键工作表标签,查看代码,粘贴进下面的代码
双击任意单元格输入,格式为:20120130 八位数字
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
stra = InputBox("请输入日期数值")
Target.Value = Left(stra, 4) & "-" & Mid(stra, 5, 2) & "-" & Right(stra, 2)
End Sub