久しぶりの投稿。
コロナ禍で有効求人倍率が0.8程度まで下がり転職市場は冷え切っている一方
経営悪化による解雇者が実質100万人を超えたという情報もあり、正直今転職するのは競争率が高く割に合わないという印象。
コロナは第3波が到来し、感染者は今後さらに増加することが予想されます。
ステイホームが求められる中、webサイト(ブログ)制作に着手し、ある程度書きたい記事は投稿したところで
次のブームとしてVBAが名乗りを上げてきた
元々、現場のデータ処理を効率化するために、おぼろげながらVBA活用案を構想していたが
仕組み構築にかける労力に対して得られる効果が少なそうだったので断念した
が
ある日VBAをうまく活用できそうな案件が転がり込んできた
それは家計簿作成
元々、妻がスマホのアプリでデータ入力をしてくれていたのだが
週/月の予算に対する出費、その内訳、レビューなど、自由にカスタマイズしたくなった
私がコードを組み、妻が使ってみて、日々改良を重ねている。
今回の記事では、その家計簿の機能を紹介しながら、VBAの難易度や習得期間、などを書き記そうと思う。
まずは家計簿の紹介

ユーザーである妻の操作は2つ
①日々の買い物の金額をセルに入力し「買い物データ入力」をクリック
②今月(先月)の入力がすべて完了したら「月更新」をクリック
左側の積み上げ式棒グラフが、週の予算に対して各週の実績(進捗)
右側の積み上げ式棒グラフが、月の予算に対して各月の実績
全て自動入力なので、上記①②の操作で勝手にグラフが更新されていき、今の立ち位置がわかる仕組み
その他機能として
・日付、金額が入力されていない状態で「買い物データ入力」をクリックすると注意喚起のメッセージボックス表示
・月の第一週にエクセルを開いた際、、「月更新」をクリックしたか確認のメッセージボックス表示(たぶん不要)
など、試行錯誤しながら機能の追加、削除を行っている
運用開始後の効果として、日々の買い物の出費に対する意識が高まり、何か買うものを選択するときに、出費状況を考慮できるようになった
また、データ入力とボタンクリックだけで、対予算の出費状況が見えるという簡易性から、継続使用できそうな雰囲気もある
妻帯者には特にお勧めします
さて、VBAに関する話をしましょう
この家計簿制作に着手するまで、私のVBAに関する知識はゼロでした
現状は、エクセルの関数と同じ感覚。すなわち、わからない動作があればググって調べれば、大抵のことはできる。ところまできています。
まだまだ初心者なのですが、少なくともそのレベルに到達するまでやったことは以下の2つ
①youtubeで学ぶ(計8時間程度)
金子さんという方の動画を見ながら、動画と同じようにマクロを組みました。
理解できないところは、一度戻ったり、0.75倍速で見ながらやりました。
以下にリンクを貼ります
②家計簿を作っちゃう(計20時間程度?)
①でVBAの骨格をある程度理解できれば、あとは肉付けをしていくだけです。エクセルと共通部分も結構あるので、実践重視で進めていった方が効率的と思います。
最後に
作成したコードを1つだけ紹介します
日付・金額を入力しなかった場合の注意喚起、入力データの転記、転記したデータの整列の機能が組み込まれてます
学習時間に対する成果の程度として、ご参考まで
※多少ノイズが含まれています。また、シート名などは自分で定義する必要があるので、このコードをコピペしても、エラー表示となります。
Sub 買い物データ入力()
Dim h As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim m As Long
Dim cnt As Long
h = WorksheetFunction.Sum(Sheets("Sheets").Range("B3:B100000"))
i = Sheets("Sheets").Cells(100000, 2).End(xlUp).Row + 1
j = WorksheetFunction.Sum(Sheets("Sheets").Range("C3:C100000"))
k = WorksheetFunction.Sum(Sheets("Sheets").Range("D3:D100000"))
l = WorksheetFunction.Sum(Sheets("Sheets").Range("E3:E100000"))
m = WorksheetFunction.Sum(Sheets("Sheets").Range("F3:F100000"))
If h = "0" Then
MsgBox ("日付を入力しましょう")
Else
If j = "0" And _
k = "0" And _
l = "0" And _
m = "0" Then
MsgBox ("金額を入力しましょう")
Else
For cnt = 3 To Sheets("Sheets").Cells(100000, 2).End(xlUp).Row
Sheets("Sheets").Cells(i, 2).Value = Sheets("Sheets").Cells(cnt, 2).Value
Sheets("Sheets").Cells(i, 3).Value = Sheets("Sheets").Cells(cnt, 3).Value
Sheets("Sheets").Cells(i, 4).Value = Sheets("Sheets").Cells(cnt, 4).Value
Sheets("Sheets").Cells(i, 5).Value = Sheets("Sheets").Cells(cnt, 5).Value
Sheets("Sheets").Cells(i, 6).Value = Sheets("Sheets").Cells(cnt, 6).Value
i = i + 1
Next
Sheets("Sheets").Range("B3:F1000").ClearContents
' key:並び替え基準セル sorton:並び替えタイプ=xlSortOnValues=セル内のデータで並べ替え
'Order:並び替え順序=xlAscending=昇順 DataOption:=xlSortNormal
Sheets("Sheets").Sort.SortFields.Clear
Sheets("Sheets").Sort.SortFields.Add _
Key:=Range("B2"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending
'以上が並び替えの条件設定。以下は並び替えの実行
With Sheets("Sheets").Sort '並び替え範囲
.SetRange Range("B1:F100000") '並び替え範囲
.Header = xlYes '1行目がタイトル行か
.MatchCase = False '大文字、小文字区別するか
.Orientation = xlTopToBottom '並び替えの方向
.SortMethod = xlPinYin 'ふりがなを使うかどうかを指定 ←不要?
.Apply '並べ替えを実行します
End With
End If
End If
End Sub
コメント