「今さら」なんてない

「自分にもできそう」を伝播させるブログ

みんな気軽に使って!4桁入力→日付や時刻に自動変換!【ExcelVBA】

Excelは今日の日付や現在時刻は入力できるけど、
他の日時の入力って面倒ですよね?

4桁の数値を入力したらそのまま変換してくれるツールはたくさんあるのに、
Excelでもできないのはおかしいので作りました。

ぜひぜひお気軽にご利用ください!


概要

  • セル内容を変更したら、そのセルの表示形式が時刻なら時刻に変換します。
  • 日付入力については、起動後に出てくるポップアップに
    4桁または6桁で入力すると日付形式で入力されます。
    別途ショートカットを設定ください(→手順参考


コピペするコード

シートモジュールにコピペするやつ

下記コードを指定のシートモジュールにコピペして下さい

Private Sub Worksheet_Change(ByVal Target As Range)
    Call 四桁入力したら時刻に変換(Target)
End Sub

標準モジュールにコピペするやつ

Sub 四桁入力したら時刻に変換(ByVal Target As Range)
    Application.EnableEvents = False '無限ループ対策

    On Error Resume Next
    flag = True 'Falseなら見積等計算プロシージャで自動計算させない
    
    With Target

        If .NumberFormatLocal = "h:mm;@" Then
            Select Case True
            '先頭に0が付く場合は桁数が減るので各パターン用意
            Case .Value Like "#"
                .Value = "00:0" & .Value
            Case .Value Like "##"
                .Value = "00:" & .Value
            Case .Value Like "###"""
                .Value = "0" & Left(.Value, 1) & _
                        ":" & Right(.Value, 2)
            Case .Value Like "####"
                .Value = Left(.Value, 2) & _
                        ":" & Right(.Value, 2)
            Case .Value Like "#:##", "##:##"    '何もしない
            Case .Value = "": flag = False      '見積等計算プロシージャで自動計算させない
            Case Else
                MsgBox "4桁の数値か時刻形式で入力してください"
                flag = False
                .Value = ""
            End Select  'True
        End If  'NumberFormatLocal
    End With    'Target
    Application.EnableEvents = True

End Sub

Sub mmddかyymmddで日付入力()
   Dim buf
   
   buf = InputBox("4桁または6桁で日付を入力してください" & vbCrLf & "(mmdd形式またはyymmdd形式)")
    
    Select Case True
    '先頭に0が付く場合は桁数が減るので各パターン用意
        Case buf = "": GoTo Cancel
        Case buf Like "####"
            buf = Year(Date) & "/" & Left(buf, 2) & "/" & Right(buf, 2)
        Case buf Like "######"
            buf = Left(Year(Date), 2) & Left(buf, 2) & "/" & Mid(buf, 3, 2) & "/" & Right(buf, 2)
        Case Else
            MsgBox "4桁or6桁の数値で入力してください"
            buf = ActiveCell.Value
    End Select
    ActiveCell.Value = buf
Cancel:
End Sub

コードの解説

セル入力イベント

Private Sub Worksheet_Change(ByVal Target As Range)
    Call 四桁入力したら時刻に変換(Target)
End Sub

セルの値が変更されたら四桁入力したら時刻に変換を即実行、これだけです。
あとの細かいことは標準モジュールに任せます。

4桁入力したら時刻に変換するやつ

If .NumberFormatLocal = "h:mm;@" Then

ここで選択セルの表示形式を見ます。
時刻形式h:mm;@なら実行し、そうでなければ悪さはしません。


Select Case True
    '先頭に0が付く場合は桁数が減るので各パターン用意
    Case .Value Like "#"
        .Value = "00:0" & .Value
    Case .Value Like "##"
        .Value = "00:" & .Value
    Case .Value Like "###"""
        .Value = "0" & Left(.Value, 1) & _
                ":" & Right(.Value, 2)
    Case .Value Like "####"
        .Value = Left(.Value, 2) & _
                ":" & Right(.Value, 2)

'先頭に0が付く場合は桁数が減るので各パターン用意とあるように、

文字列形式出でない場合、

  • 0012だと12
  • 0123だと123

となってしまい、そのままだとうまく行かないので
1桁~4桁まで1パターンずつ補正処理を用意します。


Case .Value Like "#:##", "##:##"
Ctrl+:などで最初から時刻形式で入力された場合の例外避け文です。


Case .Value = "": flag = False '見積等計算プロシージャで自動計算させない
こちらは今回のもの単独では意味がありませんが、
別のプロシージャで、時刻の計算を行うのを防ぐためにある行です。
そちらについても近々アップしますのでご利用ください。


Case Elseは頻繁に使うので是非覚えてください!
事前に例外を挙げまくっておき、それ以外は全部処理します。
例外が日本だけなら日本以外全部沈没します。


mmddかyymmddで日付入力するやつ

こちらは自動ではありません。
まずbuf = InputBox("説明文")で入力を求めるポップアップが出るので
4桁または6桁で日付を入力してください。

こちらも時刻同様、Select文で4桁の場合と6桁の場合に補正処理を分けます。
4桁の場合は自動的に今年の日付になります。
別の年を入力されるばあいは6桁入力してください。


ショートカット設定シートに作り方はこちら

Ctrl+:Ctrl'+;はOnkeyメソッドの振り方がわからないので<br> 僕はAlt+ENTER`にしています。

yoshino-ya.hatenablog.com


個人的感想

今回のものは多くの方にご利用いただきたいものになり、
個人的に大満足のネタになりました。
むしろExcelに標準装備されろ!


次回は日付や時刻を加減算するやつをアップするので
今回のものと併せて入力をもっとラクにしましょう!