家計簿アプリを、より使いやすく自分仕様に改造していきましょう！
以前の投稿で、家計簿アプリとして最低限の機能を持たせることができました。
（その６までをご確認いただいていない方は、まずは下記まとめをご確認ください。）
ただ、これは本当に最低限の機能しかなく、勘定科目も『固定費』と『変動費』しかないので、
各家庭に合った勘定科目を自由に追加できるように、
このマクロのデコレーションをしていく必要があります。
前回までで、配列に入っているデータを確認し、結果を貼り付ける配列に入力していくところまで説明しました。
今回はその続きで、貼り付ける配列に入れるデータを厳選しつつ、最終的に結果を貼り付けていきたいと思います。
いよいよ実際に【配列】を使ったマクロを書いていきます。
最初は難しいかと思いますが、頑張って【配列】を使いこなし、
ご自身のプログラミングスキルをステージアップさせていきましょう！
【本記事の目標】
配列のデータを処理していこう②
簡単なイメージは下記記事に記載していますので、イメージづくりや今回以降の流れの参考に。
また、前回までの記事については下記をご確認ください。
前回までの状況
前回までで、
内容を判定するチェックリスト（事前準備リスト）のデータ（CheckAry1）と、
ダウンロードした明細書のデータ（MeisaiAry1）
がそれぞれの配列に入っており、
それらを照合し、『入力シート』に貼り付けるための結果の配列（ResultAry1）にデータを入力した状態になっています。
今回はこのデータを少し厳選し、『入力シート』に記載の月のデータだけを選別してResultAry1に入れるようにし、
最終的に『入力』シートに貼り付けていきます。
現時点でのマクロは下記のようになっています。
Option Explicit
Sub CardMeisaiCopy()
'カード明細サンプルを貼り付けるマクロ
Dim FileName1 As String
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Set sh1 = ThisWorkbook.Worksheets("入力")
Set sh2 = ThisWorkbook.Worksheets("カード明細用")
Set sh3 = ThisWorkbook.Worksheets("銀行明細用")
Set sh4 = ThisWorkbook.Worksheets("事前準備リスト")
'配列の宣言
Dim MeisaiAry1() As Variant
Dim ResultAry1() As Variant
Dim CheckAry1() As Variant
'最終行・最終列の変数
Dim LastR1 As Integer
Dim LastC1 As Integer
'チェックリストのデータを配列に入れる
LastR1 = sh4.Cells(2, 1).End(xlDown).Row
LastC1 = sh4.Cells(2, 1).End(xlToRight).Column
CheckAry1 = sh4.Range(sh4.Cells(2, 1), sh4.Cells(LastR1, LastC1)).Value
'ファイルを開く
FileName1 = Application.GetOpenFilename
Workbooks.Open Filename:=FileName1
'明細書のデータを配列に入れる
With ActiveWorkbook.Sheets(1)
LastR1 = .Cells(2, 1).End(xlDown).Row
LastC1 = .Cells(2, 1).End(xlToRight).Column
MeisaiAry1 = .Range(.Cells(2, 1), .Cells(LastR1, LastC1)).Value
End With
'ファイルを閉じる
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
Dim i As Integer '繰り返し用記号
Dim j As Integer '繰り返し用記号
'結果を入れるResultAry1を準備する。
'結果に入れるのは、1行目：勘定科目、2行目：金額、3行目：内容、4行目：日付、の4項目
ReDim ResultAry1(1 To 4, 1 To 1)
'明細書のデータを1行ずつ繰り返しチェックしていく
For i = LBound(MeisaiAry1, 1) To UBound(MeisaiAry1, 1)
'事前準備リストに同名の記載があるか繰り返しチェックしていく
For j = LBound(CheckAry1, 1) To UBound(CheckAry1, 1)
'「支払先」と「内容」が一致するか確認
If MeisaiAry1(i, 2) = CheckAry1(j, 1) Then
'一致した場合
'結果を入れるためにReslutAry1の列を１つ大きくする
ReDim Preserve ResultAry1(1 To 4, 1 To UBound(ResultAry1, 2) + 1)
'データを入れていく
ResultAry1(1, UBound(ResultAry1, 2) - 1) = CheckAry1(j, 2) '勘定科目
ResultAry1(2, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 3) '金額
ResultAry1(3, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 2) '内容
ResultAry1(4, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 1) '日付
Exit For
'一致しなくてCheckAry1の最後まで見終わった場合
ElseIf j = UBound(CheckAry1, 1) Then
'結果を入れるためにReslutAry1の列を１つ大きくする
ReDim Preserve ResultAry1(1 To 4, 1 To UBound(ResultAry1, 2) + 1)
'勘定科目以外のデータを入れていく
ResultAry1(2, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 3) '金額
ResultAry1(3, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 2) '内容
ResultAry1(4, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 1) '日付
Exit For
End If
Next j
Next iまた現時点では、結果の配列（ResultAry1）には下記のようなデータが入っているはずです。
データの入り方自体も、縦長の配列ではなく横長の配列になっています。
これを念頭に置きながら進めていきましょう。
日付の判定
今、結果の配列（ResultAry1）に入っているデータは、ダウンロードした明細書の全てのデータが入っている状態です。
これをこの後『入力』シートに貼り付けていくのですが、『入力』シートは任意の月ごとにシートを入れ替えるようになっているので、貼り付けたいのはその任意の月のデータだけです。
そのため、ResultAry1 にデータを入れていく際、日付も考慮しながら入れていく必要があります。
そのためのマクロについて解説していきます。
まずは入力シートの月データを取得する
ResultAry1にデータを入れる際に、日付も確認しながら処理していくためには、
そもそも『入力』シートに記載の日付がいつなのかを確認する必要があります。
日付情報の取得に関しては、その９でオートフィルターを使ってデータ取得をしたときに取得方法を確認していますので、その方法を使っていきましょう。
上記では『入力』シートの「年」「月」のデータを取得するために、
これら２つを一旦変数に入れて、下記にように「年」「月」の値を取得しています。
Dim SearchYear1 as Integer
Dim SearchMonth1 as Integer
With ThisWorkbook.Sheets(“入力”)
SearchYear1 = .Range(“M4”).Value
SearchMonth1 = .Range(“O4”).Value
End With
ですので、これについてはこのままを使っていきましょう。
上記のコマンドを今のマクロにそのまま組み込めば、
『入力』シートの「年」：SearchYear1
『入力』シートの「月」：SearchMonth1
の情報がそれぞれの変数に入ります。
この情報を使って、データの判別をしていきましょう。
日付をチェックする
『入力』シートの月のデータを取得することが出来たので、
その情報を使って、明細書の日付を確認していき、貼り付けるデータを選別していきましょう。
データを選別する場合は If文 を使えば簡単に選別ができるので、
選別するための条件式を書いていきましょう。
明細書に記載されている日付は、下記のように 年.月.日 で書かれています。
ですので、 年.月. までのデータを見れば、貼り付けたいデータか判別することができます。
逆に言うと、 日 のデータはどんな値でも問題ないですよね。
このように完全一致じゃなくて、部分的に一致していればOKという場合、
これまで使っていた ”＝” を使った条件式は使えません。
（※ ”＝” を使った条件式は、完全一致の場合しか使えないため）
部分的に一致しているかどうかを判別するために使う演算子には
”＝” の代わりに ”Like” を使います。
この ”Like” の使い方は基本的には ”＝” の場合と一緒ですが、
唯一違うのは、ワイルドカードを使って部分一致を判別できる、という点です。
また、ワイルドカードを使って部分一致を判別する場合は、
Likeの左側に選別したい文字列
Likeの右側にワイルドカードを含む文字列
を指定する必要があるので、ご注意ください。
（※右左を逆にすると、判別してくれません）
【ワイルドカード】というのは、
「この部分はどんな文字列でも良いですよ～」ということを示す記号で、
『＊』（アスタリスク）を使います。
使い方としては、
文字列の最初だけ指定したい場合は ”東京*“
文字列の最後だけ指定したい場合は ”*Test”
文字列の中に含まれていればOKの場合は ”*2023年*“
と指定して使います。
詳しくは下記でも説明していますので、ご参考に。
以上を踏まえると、If文に記載する条件式は下記のようになります。
If MeisaiAry1(i, 1) Like SearchYear1 & “.” & SearchMonth1 & “.*” Then
日付のデータはMeisaiAry1の1列目に入っているため、そのデータを選別する形にしてあります。
判別作業を行う場所
上記までで、
１．入力シートの月を取得して
２．明細書に記載のデータと判別する
というところまでできています。
じゃあ、このコマンドを、今できているプログラムの中の
どの部分に記載していったらいいのでしょうか。
この判別作業は、勘定科目の判定をした後にした方が良いですか？
いえ、日付を確認して、対象月のデータでないのであれば、そもそも勘定科目の判定は不要なので、
それよりも前に確認した方が良いですよね。
じゃあ、明細書のデータを取得するよりも前にした方が良いですか？
いえ、そもそも明細書のデータが無いと判別ができないので、
それよりも後に確認した方が良いですよね。
じゃあ、明細書のデータを1行ずつ確認するよりも前の方が良いですか？
いえ、日付の確認は1行ずつ確認する必要があるので、
同じタイミングで確認しておいた方が良いです。
ということで、この判別は明細書のデータを1行ずつ確認しているところと
同じタイミングで書いておいた方が良いです。
具体的には、下記のように書くと良いです。
'入力シートの年・月のデータを取得する
Dim SearchYear1 As Integer
Dim SearchMonth1 As Integer
With sh1
SearchYear1 = .Range("M4").Value
SearchMonth1 = .Range("O4").Value
End With
Dim i As Integer '繰り返し用記号
Dim j As Integer '繰り返し用記号
'結果を入れるResultAry1を準備する。
'結果に入れるのは、1行目：勘定科目、2行目：金額、3行目：内容、4行目：日付、の4項目
ReDim ResultAry1(1 To 4, 1 To 1)
'明細書のデータを1行ずつ繰り返しチェックしていく
For i = LBound(MeisaiAry1, 1) To UBound(MeisaiAry1, 1)
'日付を確認する判別式
If MeisaiAry1(i, 1) Like SearchYear1 & "." & SearchMonth1 & ".*" Then
'事前準備リストに同名の記載があるか繰り返しチェックしていく
For j = LBound(CheckAry1, 1) To UBound(CheckAry1, 1)
'「支払先」と「内容」が一致するか確認
If MeisaiAry1(i, 2) = CheckAry1(j, 1) Then
'一致した場合
'結果を入れるためにReslutAry1の列を１つ大きくする
ReDim Preserve ResultAry1(1 To 4, 1 To UBound(ResultAry1, 2) + 1)
'データを入れていく
ResultAry1(1, UBound(ResultAry1, 2) - 1) = CheckAry1(j, 2) '勘定科目
ResultAry1(2, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 3) '金額
ResultAry1(3, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 2) '内容
ResultAry1(4, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 1) '日付
Exit For
'一致しなくてCheckAry1の最後まで見終わった場合
ElseIf j = UBound(CheckAry1, 1) Then
'結果を入れるためにReslutAry1の列を１つ大きくする
ReDim Preserve ResultAry1(1 To 4, 1 To UBound(ResultAry1, 2) + 1)
'勘定科目以外のデータを入れていく
ResultAry1(2, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 3) '金額
ResultAry1(3, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 2) '内容
ResultAry1(4, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 1) '日付
Exit For
End If
Next j
End If
Next i『入力』シートの年と月のデータについては１度取得すればOKなので、
繰り返し動作の外側に記載していますが、
日付の判別については繰り返し確認が必要なため、
For i = LBound(MeisaiAry1, 1) To UBound(MeisaiAry1, 1)
この繰り返し動作の最初に記載しています。
データを貼り付ける
ResultAry1の行列変換
日付確認の判別式を入れてしまえば、最終的ResultAry1の配列には『入力』シートの月のデータだけが入った状態になっています。
ですので、後はこれを入力シートに貼り付けるだけです。
ただ、現時点ではResultAry1の配列は下記のように行列が入れ替わった状態になっているので、これを元に戻す必要があります。
配列データの行列変換をする場合、一番簡単な方法は『TRANSPOSE関数』を使う方法です。
『TRANSPOSE関数』については下記でも説明していますので、ご参考ください。
ただしこの関数はワークシート関数ですので、使用する場合は下記のように呼び出す必要があります。
Application.WorksheetFunction.Transpose(ResultAry1)
文字が長くてややこしそうに見えますが、
１．Applicationの中の
２．WorksheetFunctionの中にある
３．Transpose関数を使って
４．ResultAry1の行列変換した配列を出す
という感じで１つ１つ分解すると分かりやすいと思います。
このように分解した結果を見ると『行列変換した配列を出す』と書いている通り、
この関数はResultAry1の形自体を変えているわけではなく、
ResultAry1を行列変換した結果を表示しているだけです。
そのため、ResultAry1は上記のままだと何も変わっていないです。
ですので、上記で表示した結果を、改めてResultAry1に入れなおすことで、
ResultAry1が行列変換されます。
ResultAry1 = Application.WorksheetFunction.Transpose(ResultAry1)
結果を貼り付ける
上記までで、ResultAry1の配列の中に、『入力』シートに貼り付けられる形式のデータが入りました。
あとはResultAry1を貼り付けるだけです！
貼り付ける先は入力シートのこの部分です。
ただ、このまま上記の部分に貼り付けてしまうと、今入っているデータを上書きしてしまいます。
そこで、この表の中の最終行を見つけて、その行の『詳細科目』の列に貼り付ける必要があります。
最終行の見つけ方は過去にも何度か出てきましたが、
End と xlUp、xlDown、xlToRight、xlToLeft を使います。
今回の場合、『詳細科目』の列は歯抜けになっている可能性があるので、
全ての行に確実に入力されている『金額』の列の最終行を確認します。
Dim sh1 As Worksheet
Dim LastR1 as Integer
Set sh1 = ThisWorkbook.Worksheets(“入力”)
With sh1
LastR1 = .Cells(.Rows.Count, 5).End(xlUp).Row
End With
後は、貼り付けたいセルにResultAry1の配列を貼り付ければ完成です。
With sh1
.Range(.Cells(LastR1 + 1, 4), .Cells(LastR1 + 1, 4)) = ReslutAry1
End With
ただ、上記のように１つのセルだけ指定してしまうと、
配列の中の１つのデータしか貼り付けてくれません。
そのため、配列を貼り付けるときは、配列のサイズと同じサイズの範囲を指定してあげる必要があります。
With sh1
.Range(.Cells(LastR1 + 1, 4), .Cells(LastR1 + 1 + _
(UBound(ResultAry1, 1) – LBound(ResultAry1, 1)) _
, 4 + _
(UBound(ResultAry1, 2) – LBound(ResultAry1, 2)) _
)) = ResultAry1
End With
配列のサイズを確認するときは LBound UBound を使います。
LBound：その配列の、指定した次元の最初の配列番号を取得
UBound：その配列の、指定した次元の最後の配列番号を取得
配列の最初の配列番号は ０ もしくは １ であることが多いですが、それ以外を指定することも可能です。
そのため、配列の幅や高さを確認する場合は、
UBound(配列, 1) – LBound(配列, 1) ※１次元
UBound(配列, 2) – LBound(配列, 2) ※２次元
とすることで、最初の配列番号がどんな場合でも計算することが出来ます。
上記をプログラムの最後に入れてあげれば、ResultAry1の配列の貼り付けが完了し、
配列を使って明細データを自動貼り付けできるプログラミングが完成です！
最終的なプログラムは下記です。
Sub CardMeisaiCopy()
'カード明細サンプルを貼り付けるマクロ
Dim FileName1 As String
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Set sh1 = ThisWorkbook.Worksheets("入力")
Set sh2 = ThisWorkbook.Worksheets("カード明細用")
Set sh3 = ThisWorkbook.Worksheets("銀行明細用")
Set sh4 = ThisWorkbook.Worksheets("事前準備リスト")
'配列の宣言
Dim MeisaiAry1() As Variant
Dim ResultAry1() As Variant
Dim CheckAry1() As Variant
'最終行・最終列の変数
Dim LastR1 As Integer
Dim LastC1 As Integer
'チェックリストのデータを配列に入れる
LastR1 = sh4.Cells(2, 1).End(xlDown).Row
LastC1 = sh4.Cells(2, 1).End(xlToRight).Column
CheckAry1 = sh4.Range(sh4.Cells(2, 1), sh4.Cells(LastR1, LastC1)).Value
'ファイルを開く
FileName1 = Application.GetOpenFilename
Workbooks.Open Filename:=FileName1
'明細書のデータを配列に入れる
With ActiveWorkbook.Sheets(1)
LastR1 = .Cells(2, 1).End(xlDown).Row
LastC1 = .Cells(2, 1).End(xlToRight).Column
MeisaiAry1 = .Range(.Cells(2, 1), .Cells(LastR1, LastC1)).Value
End With
'ファイルを閉じる
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
'入力シートの年・月のデータを取得する
Dim SearchYear1 As Integer
Dim SearchMonth1 As Integer
With sh1
SearchYear1 = .Range("M4").Value
SearchMonth1 = .Range("O4").Value
End With
Dim i As Integer '繰り返し用記号
Dim j As Integer '繰り返し用記号
'結果を入れるResultAry1を準備する。
'結果に入れるのは、1行目：勘定科目、2行目：金額、3行目：内容、4行目：日付、の4項目
ReDim ResultAry1(1 To 4, 1 To 1)
'明細書のデータを1行ずつ繰り返しチェックしていく
For i = LBound(MeisaiAry1, 1) To UBound(MeisaiAry1, 1)
If MeisaiAry1(i, 1) Like SearchYear1 & "." & SearchMonth1 & ".*" Then
'事前準備リストに同名の記載があるか繰り返しチェックしていく
For j = LBound(CheckAry1, 1) To UBound(CheckAry1, 1)
'「支払先」と「内容」が一致するか確認
If MeisaiAry1(i, 2) = CheckAry1(j, 1) Then
'一致した場合
'結果を入れるためにReslutAry1の列を１つ大きくする
ReDim Preserve ResultAry1(1 To 4, 1 To UBound(ResultAry1, 2) + 1)
'データを入れていく
ResultAry1(1, UBound(ResultAry1, 2) - 1) = CheckAry1(j, 2) '勘定科目
ResultAry1(2, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 3) '金額
ResultAry1(3, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 2) '内容
ResultAry1(4, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 1) '日付
Exit For
'一致しなくてCheckAry1の最後まで見終わった場合
ElseIf j = UBound(CheckAry1, 1) Then
'結果を入れるためにReslutAry1の列を１つ大きくする
ReDim Preserve ResultAry1(1 To 4, 1 To UBound(ResultAry1, 2) + 1)
'勘定科目以外のデータを入れていく
ResultAry1(2, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 3) '金額
ResultAry1(3, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 2) '内容
ResultAry1(4, UBound(ResultAry1, 2) - 1) = MeisaiAry1(i, 1) '日付
Exit For
End If
Next j
End If
Next i
ResultAry1 = Application.WorksheetFunction.Transpose(ResultAry1)
'貼り付け先の最終行を探し、結果を貼り付ける
With sh1
LastR1 = .Cells(.Rows.Count, 5).End(xlUp).Row
.Range(.Cells(LastR1 + 1, 4), .Cells(LastR1 + 1 + _
(UBound(ResultAry1, 1) - LBound(ResultAry1, 1)) _
, 4 + _
(UBound(ResultAry1, 2) - LBound(ResultAry1, 2)) _
)) = ResultAry1
End With
End Sub
同じ流れで銀行明細のデータも配列で処理してみよう
ここまでの流れで、カード明細のデータを配列を使って処理し、結果を貼り付けることが出来ました。
あとは同じような流れで、銀行明細のデータも配列で処理できれば、
この家計簿アプリも完成です。
銀行明細のデータを配列で処理する方法については、次回説明していきますが、
次回は少し説明の流れを変えてみます。
これまでは、やりたいことを１つずつ説明して、動きをイメージしながら積み上げていく流れで説明していきました。
次回は逆に、最初に完成後のプログラムをお見せして、それを１行ずつ確認していく流れで説明していきたいと思います。
というのも、プログラミングはある程度できるようになってくると、１つ１つのコマンドを覚えていくよりも、他の人が作ったプログラムを確認・解読し、そこから気づきを得て自身が作るプログラムに生かしていく方が、圧倒的に学習スピードが早くなります。
そのため、今回の家計簿アプリの最後で、他の人が作ったプログラムを確認・解読していくイメージを持っていただけたらと思いますので、そのような流れで説明していきたいと思います。
次の記事へ
コメント