1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

VBAマクロにて日付入力の手間を省くプログラムを作ってみた! ~PART2~

Posted at

さて、前回のPART1ではプログラム全体を掲載しただけになりましたが、今回は各コードの役割を解説していきます。

①画面処理の簡略化

Sub 月日入力()

'    Yes/No判定及び画面処理の省略

    Application.ScreenUpdating = False  //画面一つ一つの処理の動きを省略
    Application.DisplayAlerts = False  //処理中のYes/No判定を省略

②変数を定義しています。(変数名はテキトーです。すみません!!!)

    
'    変数の定義

        Dim nen As Long
        Dim tsuki1 As String
        Dim hantei1 As String
        Dim box As Date
        Dim y As Long

③次月初日の日付取得とコメントにありますが、任意の日付から1ヶ月を想定しております。

'    次月初日の日付取得

        box = Application.InputBox _
            (prompt:="日付を入力してください", Title:="日付入力", Type:=1)

///インプットボックスを呼び出し、任意の日付を入力し値を取得

④月ごとの日数判定(30日、31日、28日、29日など)

'    月ごとの日数判定のための変数に、月の値を格納

        hantei1 = Mid(Str(box), 7, 2)
///ExcelでもおなじみMid関数を使用し、月の値をhantei1に格納

⑤コメントの通りです。

'    西暦及び該当月を取得し、D2セルに表示
        
        nen = year(box)
        Sheets("家計簿").Range("D2").Value = nen & "年" & hantei1 & "月"
        y = Day(DateSerial(nen, 3, 1) - 1) ///うるう年対応

⑥条件分岐により、1月分の日付をオートフィル(Select Case使用)

'    月日入力及び月末までオートフィル
        
        Select Case hantei1
        
        
'       インプットボックスを閉じるまたはキャンセルボタン押下
        
            Case False
            
            End
            
            
'       2月の場合
            
            Case Is = "02"
            
                If y = 29 Then

                    Sheets("家計簿").Range("B9").Value = box
                    Call Sheets("家計簿").Range("B9").AutoFill(Range("B9:B37"), xlFillValues)
                    Sheets("家計簿").Range("B38:B39").Value = ""
                    
                Else
                  
                    Sheets("家計簿").Range("B9").Value = box
                    Call Sheets("家計簿").Range("B9").AutoFill(Range("B9:B36"), xlFillValues)
                    Sheets("家計簿").Range("B37:B39").Value = ""
                
                End If
                
            End
            
            
'       30日の月の場合
            
            Case Is = "04", "06", "09", "11"
            
                Sheets("家計簿").Range("B9").Value = box
                Call Sheets("家計簿").Range("B9").AutoFill(Range("B9:B38"), xlFillValues)
                Sheets("家計簿").Range("B39").Value = ""
                
                
            End
            
            
            Case Else
            
                Sheets("家計簿").Range("B9").Value = box
                Call Sheets("家計簿").Range("B9").AutoFill(Range("B9:B39"), xlFillValues)
                
            End
            
            
        End Select
        
        
End Sub

以上となります。これを参考に日付入力の呪縛から解放されていただければ幸いです!

1
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?