はじめに
前回は、変数、繰返し処理、条件分岐などのVBAプログラミングの基礎となる部分を紹介しました。
今回は前回のプログラム変更していく事で、色々な手法を学びましょう。
前回のプログラムコードは以下の通りです。
Sub macro1()
Dim i As Long
Dim cnt As Long
cnt = 0
For i = 2 To 20
If Cells(i, "A") = "山田" Then
cnt = cnt + 1
End If
Next i
MsgBox "山田さんは、" & cnt & "件ありました。"
End Sub課題：特定の担当者を抽出
「山田」さんのデータを抽出して、F列から表示させてみましょう。
プロシージャ名を違う名前にすれば、前のプログラムコードの下に記述して構いません。
Sub macro1a()
Dim i As Long
Dim r As Long
r = 2 '転記先の行番号
For i = 2 To 20
If Cells(i, "A") = "山田" Then
Cells(r, "F") = Cells(i, "A") '担当者
Cells(r, "G") = Cells(i, "B") '日付
Cells(r, "G").NumberFormatLocal = Cells(i, "B").NumberFormatLocal
Cells(r, "H") = Cells(i, "C") '商品名
Cells(r, "I") = Cells(i, "D") '金額
r = r + 1
End If
Next i
End Sub
解説
For文でデータを巡りながら、If文で「山田」さんを見つけたら、F,G,H,I列にそれぞれ値を入れていきます。
Cells(行,列) = Cells(行,列) で値を転記出来ます。（転記先 = 転記元 という順番です。）
左辺の転記先の行は、データが増えるたびに追加していかなければならないので、
変数 r を設けて転記先の行番号を指すようにします。初期値は 2 としました。
日付のコピーは、書式設定も考慮する
Cells(r, “G”).NumberFormatLocal = Cells(i, “B”).NumberFormatLocal
という部分では、値でなく「書式設定」をコピーしています。
NumberFormatLocalは、そのセルの書式設定のプロパティ（属性）です。
このように日付は、値と書式設定も考慮しないと上手くいきません。
（日付のコピーは別の機会に詳しく解説します。）
A列とF列に注目してみましょう。
A列は中央寄せになっていますが、F列はなっていませんね。
これは、値だけをコピーしたためです。今回はデータだけ欲しいのでこのままでOKです。
コメントアウト（注釈）
プログラム中で、説明や注意点などを記録したい場合は、
先頭にアポストロフィ（’）を付けると、行末までが「プログラムコードではないもの」と認識されます。
コメントアウトは、説明文などの他に、プログラムコードを無効化したい場合などにも使われます。VBEでは、コメントアウト部分が緑色の文字で表示されます。
実行結果
実行結果は以下のようになります。
課題：初期化を意識する
今度は、「大林」さんのリストを表示させてください。
If Cells(i, “A”) = “大林” Then
と変更すれば、上手くいくはずですが、前の値が残ってしまいます。
このような時は、一旦前の表示を消してから書き込むように変更しましょう。
Sub macro1b()
Dim i As Long
Dim r As Long
r = 2 '転記先の行番号
Range("F2:I20").ClearContents
For i = 2 To 20
If Cells(i, "A") = "大林" Then
Cells(r, "F") = Cells(i, "A") '担当者
Cells(r, "G") = Cells(i, "B") '日付
Cells(r, "G").NumberFormatLocal = Cells(i, "B").NumberFormatLocal
Cells(r, "H") = Cells(i, "C") '商品名
Cells(r, "I") = Cells(i, "D") '金額
r = r + 1
End If
Next i
End Sub解説
転記先の初期化は、セルの範囲 F2：I20 をクリアする事にします。
範囲を決める時は一番大きな範囲か、それ以上を想定します。
今回は20行目をセットします。
Rangeオブジェクトを使えば、複数のセルを指定できます。
書式は、
Range( “セル範囲” )
という形です。セル範囲は文字列で “F2：I20”とすればOKです。
Range(“F2:I20”).ClearContents
ClearContentsは、Rangeオブジェクトが持つ命令で、Rangeが指す範囲をクリアします。
この命令は、値だけでなく、書式設定もクリアしてくれます。
課題：2名分のデータを抽出
山田さんと中村さんのデータを抽出しましょう。
Sub macro2()
Dim i As Long
Dim r As Long
r = 2 '転記先の行番号
Range("F2:I20").ClearContents
For i = 2 To 20
If Cells(i, "A") = "山田" Or Cells(i, "A") = "中村" Then
Cells(r, "F") = Cells(i, "A") '担当者
Cells(r, "G") = Cells(i, "B") '日付
Cells(r, "G").NumberFormatLocal = Cells(i, "B").NumberFormatLocal
Cells(r, "H") = Cells(i, "C") '商品名
Cells(r, "I") = Cells(i, "D") '金額
r = r + 1
End If
Next i
End Sub解説
変更したのは以下の部分のみです。
If Cells(i, “A”) = “山田” Or Cells(i, “A”) = “中村” Then
Or 論理式「または」
Or を使えば、条件式２つを「～または、～」という風にどちらかの条件満たせば通す事が出来るようになります。
実行結果
課題：1名づつ揃えて抽出
データが混ざっていますので、山田さん、中村さんの順に並べ替えてみましょう。
'山田さんと中村さんのデータを揃えて抽出
Sub macro2a()
Dim i As Long
Dim r As Long
r = 2 '転記先の行番号
Range("F2:I20").ClearContents
For i = 2 To 20
If Cells(i, "A") = "山田" Then
Cells(r, "F") = Cells(i, "A") '担当者
Cells(r, "G") = Cells(i, "B") '日付
Cells(r, "G").NumberFormatLocal = Cells(i, "B").NumberFormatLocal
Cells(r, "H") = Cells(i, "C") '商品名
Cells(r, "I") = Cells(i, "D") '金額
r = r + 1
End If
Next i
'r の値を初期化しなければ、値は繰り越される
For i = 2 To 20
If Cells(i, "A") = "中村" Then
Cells(r, "F") = Cells(i, "A") '担当者
Cells(r, "G") = Cells(i, "B") '日付
Cells(r, "G").NumberFormatLocal = Cells(i, "B").NumberFormatLocal
Cells(r, "H") = Cells(i, "C") '商品名
Cells(r, "I") = Cells(i, "D") '金額
r = r + 1
End If
Next i
End Sub解説
難しく考えなくても、一人づつ処理すればOKです。
書き込み先の行を示す r は、初期化しなければ次の行を指してくれます。
少々冗長になりますが、コピーして変更点を変えれば済む事です。
実行結果
課題：日付の範囲で抽出
山田さんの8月のデータを抽出してください。
'山田さんの8月分のデータを抽出
Sub macro2b()
Dim i As Long
Dim r As Long
r = 2 '転記先の行番号
Range("F2:I20").ClearContents
For i = 2 To 20
'If Cells(i, "A") = "山田" And Cells(i, "B") > #7/31/2023# Then
If Cells(i, "A") = "山田" And Month(Cells(i, "B")) = 8 Then
Cells(r, "F") = Cells(i, "A") '担当者
Cells(r, "G") = Cells(i, "B") '日付
Cells(r, "G").NumberFormatLocal = Cells(i, "B").NumberFormatLocal
Cells(r, "H") = Cells(i, "C") '商品名
Cells(r, "I") = Cells(i, "D") '金額
r = r + 1
End If
Next i
End Sub解説
コメントアウトして2つの方法を示してみました。アポストロフィを付け替えれば２種類の方法を試す事が出来ます。（結果は同じですが,,,）
AND 論理式「なおかつ」
If文の条件分岐で、And を使うと「～で尚且つ～」という風に2つの条件が満足された場合に通す事が出来るようになります。
日付の比較
最初は、7月の末日以降の日付を条件とする方法です。
If Cells(i, “A”) = “山田” And Cells(i, “B”) > #7/31/2023# Then
日付を示す場合は、 # で値を囲みます。
「#2023/7/31#」 と入力してもＯＫですが、VBEで「 #7/31/2023# 」に自動で書き換わります。
ここでは日付の比較をして、7月31日以降（８月～）であれば、条件を満たしたことになります。
この方法ですと9月のデータがあれば、それも該当します。
日付から月を取り出す関数
次は、月の値が 8 である時を条件とする方法です。
If Cells(i, “A”) = “山田” And Month(Cells(i, “B”)) = 8 Then
Month関数は、日付型を与えると、その月を数値で返してくれます。
実行結果
課題：商品ごとに合計値を得る
山田さんの商品ごとの合計金額を求めてください。
Sub macro2c()
Dim i As Long
Dim r As Long
Dim total As Long
r = 2 '転記先の行番号
Range("F2:I20").ClearContents
Range("F1") = "山田"
total = 0
For i = 2 To 20
If Cells(i, "A") = Range("F1") And Cells(i, "C") = "リンゴ" Then
total = total + Cells(i, "D") '金額
End If
Next i
Cells(r, "G") = "リンゴ" '商品名
Cells(r, "H") = total
r = r + 1
total = 0
For i = 2 To 20
If Cells(i, "A") = Range("F1") And Cells(i, "C") = "スイカ" Then
total = total + Cells(i, "D") '金額
End If
Next i
Cells(r, "G") = "スイカ" '商品名
Cells(r, "H") = total
r = r + 1
total = 0
For i = 2 To 20
If Cells(i, "A") = Range("F1") And Cells(i, "C") = "メロン" Then
total = total + Cells(i, "D") '金額
End If
Next i
Cells(r, "G") = "メロン" '商品名
Cells(r, "H") = total
r = r + 1
End Sub解説
If文の条件分岐では、担当者 And 商品名で値を取得します。
商品名は、リンゴ、スイカ、メロンになります。
担当者と商品名が条件に合うとき、total 変数に値を加算していきます。
記載に関しては、担当者と日付は省略しています。
担当者はF1セルに、商品名と合計金額をG,H列にそれぞれ出力しています。
実行結果
課題：繰り返している部分を別関数に切り分ける
前回のプログラムでは、同じようなコードを繰返しているので、別関数に切り分けて書いてみましょう。
Sub macro2d()
Dim i As Long
Dim r As Long
Dim total As Long
r = 2 '転記先の行番号
Range("F2:I20").ClearContents
Range("F1") = "山田"
Call CalqItem(Range("F1"), "リンゴ", r)
r = r + 1
Call CalqItem(Range("F1"), "スイカ", r)
r = r + 1
'Call CalqItem(Range("F1"), "メロン", r)
CalqItem Range("F1"), "メロン", r '別の書き方
End Sub
'共通部分を別関数に切り出す
'tanto: 担当者
'syohin: 商品名
'row：書込む行
Sub CalqItem(tanto As String, syohin As String, row As Long)
Dim i As Long
Dim total As Long
total = 0
For i = 2 To 20
If Cells(i, "A") = tanto And Cells(i, "C") = syohin Then
total = total + Cells(i, "D") '金額
End If
Next i
Cells(row, "G") = syohin '商品名
Cells(row, "H") = total
End Sub
解説
別関数の名前を CalqItem としました。
処理ごとに異なる部分は引数として受け取るようにしています。
VBAではプロシージャの括弧内に引数を書きます。
（「引数」とは受け取る値の事です。）
切り出す際には、共通でない部分を引数で渡すようにして作ります。
引数は、tanto:（担当者）、syohin（商品名）、row（書込む行）としました。
2つ目のCall を付けない書き方では、引数に括弧を付けません。
初心者にとっては関数を切り出す方法は難しく感じると思いますが、このように関数から関数を呼び出して使うという事もできるのだと覚えておいてください。
また、このように同じような処理を取り出す事のメリットとしては、以下のような点が挙げられます。
・プログラムコードの見通しが良くなる
・改造する際に書き変える場所が減るので、ミスが起こりにくくなる
自作関数を呼び出す方法
関数を呼び出す方法は2つあります。
Call CalqItem(Range(“F1”), “メロン”, r)
Call 関数名（引数）
CalqItem Range(“F1”), “メロン”, r
関数名 引数
まとめ
基本となる形を覚えたら「こんなことは出来ないか？」というふうに少しずつ変形させて完成させて、小さな成功体験を積んでいけば無理なく成長できると思います。
今回扱ったトピックをまとめておきます。
・Cells(行,列) = Cells(行,列) で値を転記
・Cells(行,列).NumberFormatLocal = Cells(行,列).NumberFormatLocal で書式設定を転記
・コメントアウト アポストロフィ（’）から行末は実行されない
・Rangeオブジェクトは単体のセルだけでなく複数のセルを指定できる
・Range().ClearContents はセルの値をクリアする
・If文 And、Or 演算子
・日付型を直接書く方法 （#7/31/2023#）
・Month関数 日付の「月」部分を取り出す
・同じ項目で合計値を得る
・同じようなプログラム部分を別関数にして呼び出す
入門講座 目次
・開発環境を整える
・VBAプログラムの基礎
・VBAプログラムの基礎２
・セルの使い方
・ブックやシートの参照
・プログラムでの日付の扱い方
・プロシーシャの使い方
・「マクロの記録」を利用する
・デバッグのやり方
・やりたい事の調べ方と解決方法
・自力でプログラムを書いてみる
・別ブックのデータを集計
・別ブックのデータを集計 2
コメント