VBAを家計簿に活用 レシート集計

VBA

私は家計簿をつけるときにアプリを使っていますが、レシートの合計金額をそのまま一つの勘定科目で入力するということはしていません。

一つのレシートには食費や消耗品などが含まれているからです。

そのため一度エクセルで品物毎の金額を入力して費用科目を割り当てています。

しかし、この作業は続けていると結構面倒くさいのです。

「すこしでも楽になりたい。効率化したい。」と思いからVBAを使ってマクロを導入することにしました。

この記事では今回作成したマクロを紹介します。

目次

表のイメージ

A列に税区分を入力

  • 「0」 不課税
  • 「1」 通常税率
  • 「””」(ブランク) 軽減税率

食品(軽減税率の品物)を買うことが圧倒的に多いので空欄であれば軽減税率となるようにしました。

B列の税抜欄に金額を入力

レシートの内容を見ながら金額を入力していきます。

値引きがあるようなら値引き後の金額を入力します。

正直、IF関数を使って

=IF(A3=0,ROUND(B3*1),IF(A3=1,ROUND(B3*1.1),ROUND(B3*1.08)))

と入力してしまう方が速いですが、VBAの練習ということで…

D列に費用科目を入力

レシートの品物を見ながら費用科目を設定していきます。

コーヒーを買ったから「嗜好品」といった感じです。

家計簿アプリに入力するときには費用科目ごとに入力したいので並べ替え(ソート)をして集計しやすくします。

今回は昇順で設定しましたが、降順でも構いません。

好みの問題です。

VBAコード

Sub レシート集計()

    Dim 選択行 As Byte
    Dim 選択行2 As Byte
    Dim 行数 As Byte
    Dim 税率 As Single
    Dim 金額 As Integer
    Dim 開始行 As Byte
    Dim 終了行 As Byte
    Dim 検索条件 As String
    Dim 開始行2 As Byte
    
    
    
    Application.ScreenUpdating = False
    
    選択行 = ActiveCell.Row
    選択行2 = 選択行
    行数 = 1
    
    
'#### アクティブセルがB列でC列が空欄なら
    If ActiveCell = Cells(選択行, 2) And Cells(選択行, 3) = "" Then
    
        ActiveCell.Select
        Do Until ActiveCell.Value = ""      'セルが空欄になるまで
    
            Select Case Cells(選択行, 1).Value      '税率設定
                Case Is = 1
                    税率 = 0.1      '通常税率
                    Cells(選択行, 1).Value = "10%"
                Case Is = ""
                    税率 = 0.08     '軽減税率
                    Cells(選択行, 1).Value = "軽"
                Case Is = 0
                    税率 = 0#       '不課税
                    Cells(選択行, 1).Value = "不"
            End Select
        
            
'#### 税込額を計算
            Cells(選択行, 3).Formula = Round(Cells(選択行, 2) * (1 + 税率))
            選択行 = 選択行 + 1     '次の行を指定
            ActiveCell.Offset(1).Select     '一つ下の行を参照
        Loop
    
    
'#### 番号を振る
        Do Until Cells(選択行2, 2) = ""
            Cells(選択行2, 5) = 行数
            選択行2 = 選択行2 + 1
            行数 = 行数 + 1
        
        Loop
    
    
        終了行 = ActiveCell.Row - 1
    
        
'#### 並べ替え(ソート)
        With ActiveSheet.Sort
            .SortFields.Clear
            .SortFields.Add Key:=Cells(終了行, 4), _
                SortOn:=xlSortOnValues, Order:=xlAscending      'D列を基準にして昇順ソート
            .SetRange Cells(終了行, 1).CurrentRegion        '全範囲を指定
            .Header = xlNo      '先頭行を含まない
            .Apply      '実行
        End With
    
        開始行 = 終了行 - Cells(終了行, 1).CurrentRegion.Rows.Count + 1
    
    

'#### D列をH列に複写
        ActiveSheet.Range(Cells(開始行, 4), Cells(終了行, 4)).Copy Range(Cells(開始行, 8), Cells(開始行, 8))
    

'#### 重複を削除
        Range(Cells(開始行, 8), Cells(終了行, 8)).RemoveDuplicates Columns:=Array(1), Header:=xlNo
    

'#### 新たに開始行2を設定
        開始行2 = 開始行
           
    
'#### 費用科目毎に合計(SumIf関数)
        Do Until Cells(開始行2, 8) = ""
            検索条件 = Cells(開始行2, 8).Text   'Textで文字列を取得
            Cells(開始行2, 9) = WorksheetFunction.SumIf(Range(Cells(開始行, 4), Cells(終了行, 4)), 検索条件, Range(Cells(開始行, 3), Cells(終了行, 3)))
            '変数:「検索条件」は既に文字列をとして取得しているので、""で囲んではいけない。
        
            開始行2 = 開始行2 + 1
        Loop
    
    
'#### 金額を合計して出力
        金額 = WorksheetFunction.Sum(Range(Cells(開始行, 3), Cells(選択行, 3)))
        Cells(開始行2, 8) = "合計"
        Cells(開始行2, 9).Value = 金額
        Range(Cells(開始行2, 8), Cells(開始行2, 9)).Interior.Color = RGB(255, 255, 0)
    
    
'#### アクティブセルがB列でC列が空欄ではない場合
    Else
        MsgBox "B列を選択していないか既に処理済み"
    
    End If
    
    
    Application.ScreenUpdating = True
    
    
End Sub

コード説明

このマクロを説明します。

変数の宣言

変数データ型
選択行Byteアクティブセルの行数を取得
選択行2ByteE列に番号を振るときに使用
行数ByteE列に番号を振るときの番号
税率Single税率を格納
金額IntegerC列の税込額の合計
開始行ByteC列を合計するときの起点を取得
終了行Byteアクティブセルが表の一つ下の行まで移動するので-1として最終行を指定
検索条件StringSumIf関数の検索条件を格納
開始行2Byte科目ごとの集計に使用

まず処理に必要な変数を宣言していますが、初心者ですので行き当たりばったりで必要と感じたものを追加しています。

自分が指定した行から処理を始める仕様にしたかったので、まずは「選択行」という変数を宣言してアクティブセルの行数を取得します。

ちなみに「選択行」のデータ型については255行まで行数を使う可能性が低いためByte(0~255の整数)を指定しています。

Select case文

B列の開始行を指定した場合にだけ処理を始めるためにif文を使い、条件を満たす場合のみA列で設定した区分に応じてSelect case文で「税率」変数に税率を格納するとともにA列で入力した区分を「10%」、「軽」、「不」の三つに表示を変更する仕組みです。

「税率」は少数第二位までの比較的精度の低い数値を格納したいのでここではSingleというデータ型です。

Do until文

税率設定後にDo until文を使って、税抜額を入力した行数分だけB列に税率を乗じて税込額を入力する処理を繰り返しています。

ここで使う税率はA列の区分に応じて

その後、D列の費用区分順にデータを並べ替えます。

Msgbox

最後にC列の税込額を合計してメッセージボックスで表示させます。

合計に関しては端数処理の関係でレシートの額と一致しない場合があります。

コメント

タイトルとURLをコピーしました