私は家計簿をつけるときにアプリを使っていますが、レシートの合計金額をそのまま一つの勘定科目で入力するということはしていません。
一つのレシートには食費や消耗品などが含まれているからです。
そのため一度エクセルで品物毎の金額を入力して費用科目を割り当てています。
しかし、この作業は続けていると結構面倒くさいのです。
「すこしでも楽になりたい。効率化したい。」と思いから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 | アクティブセルの行数を取得 |
選択行2 | Byte | E列に番号を振るときに使用 |
行数 | Byte | E列に番号を振るときの番号 |
税率 | Single | 税率を格納 |
金額 | Integer | C列の税込額の合計 |
開始行 | Byte | C列を合計するときの起点を取得 |
終了行 | Byte | アクティブセルが表の一つ下の行まで移動するので-1として最終行を指定 |
検索条件 | String | SumIf関数の検索条件を格納 |
開始行2 | Byte | 科目ごとの集計に使用 |
まず処理に必要な変数を宣言していますが、初心者ですので行き当たりばったりで必要と感じたものを追加しています。
自分が指定した行から処理を始める仕様にしたかったので、まずは「選択行」という変数を宣言してアクティブセルの行数を取得します。
ちなみに「選択行」のデータ型については255行まで行数を使う可能性が低いためByte(0~255の整数)を指定しています。
Select case文
B列の開始行を指定した場合にだけ処理を始めるためにif文を使い、条件を満たす場合のみA列で設定した区分に応じてSelect case文で「税率」変数に税率を格納するとともにA列で入力した区分を「10%」、「軽」、「不」の三つに表示を変更する仕組みです。
「税率」は少数第二位までの比較的精度の低い数値を格納したいのでここではSingleというデータ型です。
Do until文
税率設定後にDo until文を使って、税抜額を入力した行数分だけB列に税率を乗じて税込額を入力する処理を繰り返しています。
ここで使う税率はA列の区分に応じて
その後、D列の費用区分順にデータを並べ替えます。
Msgbox
最後にC列の税込額を合計してメッセージボックスで表示させます。
合計に関しては端数処理の関係でレシートの額と一致しない場合があります。
コメント