0
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 1 year has passed since last update.

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

Last updated at Posted at 2022-04-27

今回はVBAにて日付入力の手間を省くプログラムについてご紹介いたします。

皆さんはこんな経験ございませんか?月の1日を入力し、フィルハンドルを使って日付をコピーするという作業です。これって面倒ですよね!?今回はマクロボタンをポチッと押すだけで、各月の1日を入力すれば日付が自動で反映されるプログラムを紹介いたします。

フィルハンドルを使用
image.png

このマクロにて簡略化
image.png
image.png
画面右上の"月日入力"ボタンを押して、任意の月の1日の日付を入力するとその月の日付がすべて入力される仕様となっております。そのコードを下に記載します。

Sub 月日入力()

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

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    
'    変数の定義

        Dim nen As Long
        Dim tsuki1 As String
        Dim hantei1 As String
        Dim box As Date
        Dim y As Long
        
               
'    次月初日の日付取得

        box = Application.InputBox _
            (prompt:="日付を入力してください", Title:="日付入力", Type:=1)
            
    
'    月ごとの日数判定のための変数に、月の値を格納

        hantei1 = Mid(Str(box), 7, 2)
        
             
'    西暦及び該当月を取得し、D2セルに表示
        
        nen = year(box)
        Sheets("家計簿").Range("D2").Value = nen & "年" & hantei1 & "月"
        y = Day(DateSerial(nen, 3, 1) - 1)
        
            
'    月日入力及び月末までオートフィル
        
        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

これが、一連のコードの流れになります。コメントも記載しておりますので、プログラムコードの意味は理解できるかと思いますが、次回解説も入れたいと思います。

0
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
0
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?