Excel VBAで食費管理マクロを作成

食費がどれだけ使っているか調べたいと思いマクロを作成しました。

機能としては
・今月使った食費入力して登録（別シートに今月の食費が登録される）
・食費クリア

画面説明

１、「月登録」で登録したい月を選択します。
２、各食材の金額を入力します。
３、食材の金額が入力できると「登録ボタン」を押下します。
４、「クリアボタン」を押下すると、画面が初期状態に戻ることができます。
　　※登録が成功することでクリアが可能です。

登録が成功すると新しいシートが追加されます。
１、年，月，食費の合計が表示されます。
２、年，月がシート名になります。。

実装

標準モジュール

Sub 食費登録()
'合計
Dim go As Long, last As Long, i As Long, w As Long
w = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row

 If Sheet1.Range("E1").Value = "" Then
    
           MsgBox "登録したい月を選択してください。"
    Else

            If Sheet1.Range("A" & w).Value Like "*合計*" Then 'Aの最終行に合計があると登録できないようにしている
            
                         MsgBox "合計は登録済みです。"
                        Exit Sub '処理は終了します
            
            Else
                         For i = 2 To 14 Step 3 '2列飛ばし、14列まで
                      go = Sheet1.Cells(Rows.Count, i).End(xlUp).Row + 1
                    
                      last = Sheet1.Cells(Rows.Count, i).End(xlUp).Row '最後の行数を取得
                    
                
                        If (i = 2) Then
                         Sheet1.Range("B" & go).Value = Application.WorksheetFunction.Sum(Range("B4:B" & last))
                         Sheet1.Range("A" & go).Value = "合計"
                        End If
                        
                        If (i = 5) Then
                         Sheet1.Range("E" & go).Value = Application.WorksheetFunction.Sum(Range("E4:E" & last))
                         Sheet1.Range("D" & go).Value = "合計"
                        End If
                        
                        If (i = 8) Then
                         Sheet1.Range("H" & go).Value = Application.WorksheetFunction.Sum(Range("H4:H" & last))
                         Sheet1.Range("G" & go).Value = "合計"
                        End If
                        
                        If (i = 11) Then
                         Sheet1.Range("K" & go).Value = Application.WorksheetFunction.Sum(Range("K4:K" & last))
                         Sheet1.Range("J" & go).Value = "合計"
                        End If
                        
                        If (i = 14) Then
                         Sheet1.Range("N" & go).Value = Application.WorksheetFunction.Sum(Range("N4:N" & last))
                         Sheet1.Range("M" & go).Value = "合計"
                        End If
                       Next i
                     MsgBox "登録しました。"
            End If
            
            '線を引く
            Worksheets(1).Range("A4").CurrentRegion.Borders.LineStyle = xlContinuous
        
            Worksheets(1).Range("D4").CurrentRegion.Borders.LineStyle = xlContinuous
            
            Worksheets(1).Range("G4").CurrentRegion.Borders.LineStyle = xlContinuous
            
            Worksheets(1).Range("J4").CurrentRegion.Borders.LineStyle = xlContinuous
            
            Worksheets(1).Range("M4").CurrentRegion.Borders.LineStyle = xlContinuous
            
        
        '日付,食費合計表示
        Dim dates As String, so As Range, b As Long, e As Long, h As Long, k As Long, n As Long
        
         
             b = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
             e = Sheet1.Cells(Rows.Count, 5).End(xlUp).Row
             h = Sheet1.Cells(Rows.Count, 8).End(xlUp).Row
             k = Sheet1.Cells(Rows.Count, 11).End(xlUp).Row
             n = Sheet1.Cells(Rows.Count, 14).End(xlUp).Row
             
            Set so = Union(Range("B" & b), Range("E" & e), Range("H" & h), Range("K" & k), Range("N" & n))
             
           
            
               dates = year(Date) & "年" & Range("E1").Value & "食費"
                
                
                 Range("A1").Value = dates & Space(5) & "合計：" & Format(Application.WorksheetFunction.Sum(so), "#,###円")
             
            'ワークシートをコピー
            Sheet1.Copy After:=Sheet1
            
             'ボタン削除
             ActiveSheet.Shapes.SelectAll
             Selection.Delete
             ActiveSheet.Range("E1").Value = ""
             
            ActiveSheet.Name = dates
    End If

End Sub

'----------------------------------------------------------------------------------------------------------------------
Sub 食費クリア()
Dim ma As Long, sa As Long, w As Long

w = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

    If Sheet1.Range("A" & w).Value Like "*合計*" Then 'Aの最終行に合計がある場合のみクリア可能
   
                For i = 1 To 13 Step 3 '2列飛ばし、13列まで
                
                     ma = Sheet1.Cells(Rows.Count, i).End(xlUp).Row - 1 '最終行-1
                
                     sa = Sheet1.Cells(Rows.Count, i).End(xlUp).Row
                     
                     If (i = 1) Then
                      Sheet1.Range("B4:B" & ma).Value = "0" '各食材に0を挿入。食材は２個以上存在すること
                      Sheet1.Range("A" & sa).ClearContents  '削除
                      Sheet1.Range("B" & sa).ClearContents
                     End If
                     
                     If (i = 4) Then
                      Sheet1.Range("E4:E" & ma).Value = "0"
                      Sheet1.Range("D" & sa).ClearContents
                      Sheet1.Range("E" & sa).ClearContents
                     End If
                     
                     If (i = 7) Then
                     Sheet1.Range("H4:H" & ma).Value = "0"
                     Sheet1.Range("G" & sa).ClearContents
                     Sheet1.Range("H" & sa).ClearContents
                     End If
                     
                     If (i = 10) Then
                     Sheet1.Range("K4:K" & ma).Value = "0"
                     Sheet1.Range("J" & sa).ClearContents
                     Sheet1.Range("K" & sa).ClearContents
                    
                     End If
                     
                     If (i = 13) Then
                     Sheet1.Range("N4:N" & ma).Value = "0"
                     Sheet1.Range("M" & sa).ClearContents
                     Sheet1.Range("N" & sa).ClearContents
                     End If
                 Next i
             Sheet1.Range("A1").MergeArea.ClearContents 'A1,B2の内容クリア
             Sheet1.Range("A1").Value = "食費"
             Sheet1.Range("E1").Value = ""
        
             MsgBox "クリアしました。"
             
     Else
     
            MsgBox "登録してからクリアして下さい。"
            Exit Sub '処理は終了します
    End If

End Sub

'----------------------------------------------------------------------------------------------------------------------
Sub myform1()
    UserForm1.Show
End Sub

フォーム

Private Sub CommandButton1_Click()
Range("E1").Value = ComboBox1.Value & "月"
    Unload Me
End Sub

Private Sub UserForm_Initialize()
  Dim i As Long
    
    '月のコンボボックス　１２ヶ月
    For i = 1 To 12
        ComboBox1.AddItem i
    Next
    '初期値は現在の月
    ComboBox1.Value = Month(Date)
End Sub

運用してみて不具合があれば修正していきたいと思います。