日付入力マクロ
On Error Resume Next
Dim r As Range
Dim flg As Long
flg = 0
If Intersect(Target, Range("A4:A600,E4:E600,J4:J600")) Is Nothing Then Exit Sub 'A列のみを対象 最初につなげるところ
ActiveSheet.Unprotect
flg = 1
For Each r In Target
Dim a As Long
Dim b As String
With r
If Not .NumberFormatLocal = "ge.m.d" Or .Value = "" Then .NumberFormatLocal = "G/標準" 'セルの書式設定がH00.m.d形式だったら標準に戻す
'セルが 数字 且 整数 且 101以上 且 991231以下 の場合
If IsNumeric(.Value) And Int(.Value) = .Value And .Value >= 19010101 And .Value <= 20991231 Then
b = Left(.Value, 4) & "/" & Mid(.Value, 5, 2) & "/" & Right(.Value, 2)
If IsDate(b) Then 'もしbがDateの形なら
.Value = CDate(b) 'データ型を日付にする
'ここにつなげる。 変数はtmpからbに直す
.NumberFormatLocal = "ggg" & _
IIf(Format(b, "e") > 9, "e年", "_0e年") & _
IIf(Month(b) > 9, "m月", "_1m月") & _
IIf(Day(b) > 9, "d日", "_1d日")
ActiveSheet.Protect
End If
End If
End With
Next
End Sub
上記のマクロで20090731と入力すると平成21年7月31日と表示されます。
210731を入力して平成21年7月31日と表示されるようにすることは可能ですか？
お礼
ありがとうございます。