イントロダクション
前回(第23回)は、End(xlUp) を使って、表の最終行を取得する方法を学んだ。最終行が分かれば、行数が変わる表でも、最後のデータまでを過不足なく扱える。
今回は、その最終行を使って、表を1行ずつ処理する。
さらに、条件に合う行だけを、別のシートに抜き出して転記するマクロを作る。
「売上が1,000円以上の行だけを取り出したい」「特定の担当者の行だけを集めたい」といった作業は、実務でもよくある。
表データの処理編は、次の3回構成である。
- 第23回:データの最終行を取得する
- 第24回(今回):表を1行ずつ処理する(条件に合う行を抽出して転記する)
- 第25回:配列を使って、処理を高速化する
【準備】担当者つきのサンプルデータを用意する
今回は、第23回の表に「担当」の列を加えて、行数も増やした、次の表を使う。シート名は、第23回と同じ「売上データ」である。
| A | B | C | D | |
|---|---|---|---|---|
| 1 | 日付 | 商品 | 売上 | 担当 |
| 2 | 10/1 | りんご | 1200 | 田中 |
| 3 | 10/2 | みかん | 800 | 佐藤 |
| 4 | 10/3 | ぶどう | 1500 | 田中 |
| 5 | 10/4 | バナナ | 600 | 鈴木 |
| 6 | 10/5 | メロン | 2000 | 佐藤 |
| 7 | 10/6 | いちご | 900 | 田中 |
| 8 | 10/7 | もも | 1100 | 鈴木 |
| 9 | 10/8 | りんご | 1300 | 佐藤 |
| 10 | 10/9 | みかん | 700 | 田中 |
| 11 | 10/10 | ぶどう | 1800 | 鈴木 |
次のマクロを、マクロ有効ブックの標準モジュールに貼り付けて実行すれば、この表が自動で作られる。
Sub 担当者つきサンプルデータを作る()
Dim ws As Worksheet
Dim 商品 As Variant
Dim 売上 As Variant
Dim 担当 As Variant
Dim i As Long
' 「売上データ」シートがあれば使い、なければ新しく作る
On Error Resume Next
Set ws = ThisWorkbook.Worksheets("売上データ")
On Error GoTo 0
If ws Is Nothing Then
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = "売上データ"
Else
ws.Cells.ClearContents
End If
商品 = Array("りんご", "みかん", "ぶどう", "バナナ", "メロン", "いちご", "もも", "りんご", "みかん", "ぶどう")
売上 = Array(1200, 800, 1500, 600, 2000, 900, 1100, 1300, 700, 1800)
担当 = Array("田中", "佐藤", "田中", "鈴木", "佐藤", "田中", "鈴木", "佐藤", "田中", "鈴木")
' 見出しと、10件のデータを書き込む
ws.Range("A1:D1").Value = Array("日付", "商品", "売上", "担当")
For i = 0 To 9
ws.Cells(i + 2, 1).Value = DateSerial(2026, 10, i + 1)
ws.Cells(i + 2, 2).Value = 商品(i)
ws.Cells(i + 2, 3).Value = 売上(i)
ws.Cells(i + 2, 4).Value = 担当(i)
Next i
ws.Range("A2:A11").NumberFormat = "m/d"
End Sub「売上データ」シートがすでにある場合は、中身を消してから書き込むので、第23回で作った表は、この表に置き換わる。そのシートが置き換わっても問題ないことを確認してから実行しよう。
また、今回のマクロは、第23回で作った次の Function を使う。
同じ標準モジュールに入っていることを確認しておこう。
Function 最終行を取得する(ws As Worksheet, 列番号 As Long) As Long
最終行を取得する = ws.Cells(ws.Rows.Count, 列番号).End(xlUp).Row
End Function表を1行ずつ処理する基本形
表を1行ずつ処理するには、For を使って、2行目から最終行まで、行番号を1つずつ増やしながら繰り返す。
Sub 表を1行ずつ読み取る()
Dim ws As Worksheet
Dim 最終行 As Long
Dim 行 As Long
Set ws = ThisWorkbook.Worksheets("売上データ")
最終行 = 最終行を取得する(ws, 1)
For 行 = 2 To 最終行
Debug.Print ws.Cells(行, 2).Value & ":" & ws.Cells(行, 3).Value
Next 行
End Sub実行して、イミディエイトウィンドウ(Ctrl + G)を見てみよう。次のように、10行ぶんの商品名と売上が表示される。実行前に、イミディエイトウィンドウを Ctrl + A → Delete で空にしておくと、見やすい。

ポイントは、次の3つである。
For 行 = 2 To 最終行
変数行が、2、3、4…と1ずつ増えながら、最終行まで繰り返す。2は、見出しの次の行(データの1行目)である。行番号なので、変数はLongで宣言するws.Cells(行, 列番号)
「何行目の、何列目のセルか」を指定する。繰り返しのたびに行の値が変わるので、1行ずつ順番に読み取れる- 列番号
今回の表では、1が日付、2が商品、3が売上、4が担当である
F8 キーで1行ずつ実行しながら、行 の値が増えていく様子を確かめると、動きがよく分かる。
条件に合う行だけを処理する
繰り返しの中に If を入れれば、条件に合う行だけを処理できる。売上が1,000以上の行だけを、表示してみよう。
Sub 売上が1000以上の行を表示する()
Dim ws As Worksheet
Dim 最終行 As Long
Dim 行 As Long
Set ws = ThisWorkbook.Worksheets("売上データ")
最終行 = 最終行を取得する(ws, 1)
For 行 = 2 To 最終行
If ws.Cells(行, 3).Value >= 1000 Then
Debug.Print ws.Cells(行, 2).Value & ":" & ws.Cells(行, 3).Value
End If
Next 行
End Sub次の6件が表示される。

条件に合う行を別シートに抽出・転記する
次は、条件に合う行を、別のシートに書き出すマクロを作る。まず、書き出し先のシートを用意する Function を作っておこう。第22回の 集計シートを用意する を、シート名を指定できる形にしたものである。
Function シートを用意する(シート名 As String) As Worksheet
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(シート名)
On Error GoTo 0
If ws Is Nothing Then
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = シート名
Else
ws.Cells.ClearContents
End If
Set シートを用意する = ws
End Functionこの Function を使って、売上が1,000以上の行を「抽出結果」シートに転記する。
Sub 売上1000以上を抽出する()
Dim 元シート As Worksheet
Dim 先シート As Worksheet
Dim 最終行 As Long
Dim 行 As Long
Dim 書込行 As Long
Set 元シート = ThisWorkbook.Worksheets("売上データ")
最終行 = 最終行を取得する(元シート, 1)
If 最終行 < 2 Then
MsgBox "データがありません。", vbExclamation
Exit Sub
End If
Set 先シート = シートを用意する("抽出結果")
' 見出しをコピーする
元シート.Range("A1:D1").Copy 先シート.Range("A1")
書込行 = 2
' 条件に合う行を、先シートに詰めて転記する
For 行 = 2 To 最終行
If 元シート.Cells(行, 3).Value >= 1000 Then
元シート.Range(元シート.Cells(行, 1), 元シート.Cells(行, 4)).Copy 先シート.Cells(書込行, 1)
書込行 = 書込行 + 1
End If
Next 行
Application.CutCopyMode = False
MsgBox (書込行 - 2) & " 件を抽出しました。"
End Sub実行すると、「6 件を抽出しました。」と表示される。

マクロ有効ブックに「抽出結果」というシートが作られ、見出しと、条件に合う6行が転記されているはずである。

コードの要点を、順に見ていこう。
元シートと先シート
読み取るシートと、書き込むシートを、別々の変数に入れている。どちらのシートを操作しているのかが分かりやすくなる書込行
書き込み先の行番号を管理する変数である。元の表の行番号(行)とは別に用意する。条件に合う行だけを、先頭から詰めて書き込むため、条件に合う行が見つかるたびに、書込行を1つ増やしているRange(Cells(行, 1), Cells(行, 4))
その行の、A列からD列までのセル範囲を指定する書き方である.Copy 先シート.Cells(書込行, 1)
セルの範囲を、指定した場所にコピーする。日付の表示形式(m/d)もそのまま引き継がれるApplication.CutCopyMode = False
コピーしたセルの周りに表示される点線(コピーの範囲を示す枠)を消す(書込行 - 2)
書き込んだ件数である。書込行は、次に書き込む行を指しているので、2行目から数えて、「書込行- 2」が件数になる
複数の条件を指定する
条件が複数あるときは、And や Or を使う。
| 演算子 | 意味 |
|---|---|
And | 両方の条件を満たすとき |
Or | どちらか一方でも満たすとき |
たとえば、「売上が1,000以上」で、かつ「担当が田中」の行を抽出するマクロは、次のようになる。先ほどの 売上1000以上を抽出する と比べて、If の行だけが違う
Sub 売上1000以上かつ田中を抽出する()
Dim 元シート As Worksheet
Dim 先シート As Worksheet
Dim 最終行 As Long
Dim 行 As Long
Dim 書込行 As Long
Set 元シート = ThisWorkbook.Worksheets("売上データ")
最終行 = 最終行を取得する(元シート, 1)
If 最終行 < 2 Then
MsgBox "データがありません。", vbExclamation
Exit Sub
End If
Set 先シート = シートを用意する("抽出結果")
' 見出しをコピーする
元シート.Range("A1:D1").Copy 先シート.Range("A1")
書込行 = 2
' 売上が1000以上で、かつ担当が田中の行を転記する
For 行 = 2 To 最終行
If 元シート.Cells(行, 3).Value >= 1000 And 元シート.Cells(行, 4).Value = "田中" Then
元シート.Range(元シート.Cells(行, 1), 元シート.Cells(行, 4)).Copy 先シート.Cells(書込行, 1)
書込行 = 書込行 + 1
End If
Next 行
Application.CutCopyMode = False
MsgBox (書込行 - 2) & " 件を抽出しました。"
End Sub実行すると、「2 件を抽出しました。」と表示され、10/1のりんごと、10/3のぶどうの2行が転記される。田中さんの行でも、売上が1,000円未満の行(10/6、10/9)は、含まれない。
And と Or を混ぜて使うときは、かっこ ( ) で囲んで、どの条件を先に判定するのかを明確にしよう。たとえば、「売上が1,000以上で、担当が田中か佐藤」の行を抽出するマクロは、次のようになる。こちらも、If の行だけが違う。
Sub 売上1000以上かつ田中か佐藤を抽出する()
Dim 元シート As Worksheet
Dim 先シート As Worksheet
Dim 最終行 As Long
Dim 行 As Long
Dim 書込行 As Long
Set 元シート = ThisWorkbook.Worksheets("売上データ")
最終行 = 最終行を取得する(元シート, 1)
If 最終行 < 2 Then
MsgBox "データがありません。", vbExclamation
Exit Sub
End If
Set 先シート = シートを用意する("抽出結果")
' 見出しをコピーする
元シート.Range("A1:D1").Copy 先シート.Range("A1")
書込行 = 2
' 売上が1000以上で、かつ担当が田中か佐藤の行を転記する
For 行 = 2 To 最終行
If 元シート.Cells(行, 3).Value >= 1000 And (元シート.Cells(行, 4).Value = "田中" Or 元シート.Cells(行, 4).Value = "佐藤") Then
元シート.Range(元シート.Cells(行, 1), 元シート.Cells(行, 4)).Copy 先シート.Cells(書込行, 1)
書込行 = 書込行 + 1
End If
Next 行
Application.CutCopyMode = False
MsgBox (書込行 - 2) & " 件を抽出しました。"
End SubAnd は Or より先に判定されるので、かっこがないと、意図とは違う条件になってしまう。この条件では、4件(10/1、10/3、10/5、10/8)が抽出される。
また、文字列の比較(= "田中")は、完全に一致したときだけ True になる。セルの値の前後に、余分な空白が混ざっていると一致しないので、そのときは Trim 関数で空白を取り除いてから比較するとよい。
【落とし穴】数値の列に文字が混ざっていたら
実際の表では、数値の列に、文字が混ざっていることがある。この場合に、どうなるのか試してみよう。先ほどの 売上が1000以上の行を表示する を使う。表のC4セル(10/3のぶどうの売上)を、未入力 という文字に書き換えてから、実行してみよう。
エラーにならずに、次のように表示される。

売上が「未入力」という文字の行が、「1,000以上」の行として表示されてしまっている。VBAでは、文字列は数値より大きいものとして比較されるため、文字の「未入力」が >= 1000 の条件を満たしてしまうのである。エラーで止まれば、問題に気づける。しかし、エラーにならずに間違った結果が混ざるので、かえって気づきにくい。
先ほどの抽出のマクロでも、同じことが起きて、売上が数値でない行が、抽出結果に混ざってしまう。
このようなエラーを防ぐには、第19回で学んだ事前チェックが使える。IsNumeric 関数で、数値として扱えるかどうかを、比較の前に確認しよう。
Sub 数値を確かめて表示する()
Dim ws As Worksheet
Dim 最終行 As Long
Dim 行 As Long
Set ws = ThisWorkbook.Worksheets("売上データ")
最終行 = 最終行を取得する(ws, 1)
For 行 = 2 To 最終行
If Not IsNumeric(ws.Cells(行, 3).Value) Then
Debug.Print 行 & "行目の売上が数値ではありません。"
ElseIf ws.Cells(行, 3).Value >= 1000 Then
Debug.Print ws.Cells(行, 2).Value & ":" & ws.Cells(行, 3).Value
End If
Next 行
End SubC4が文字のままなら、「4行目の売上が数値ではありません。」と表示され、その行を飛ばして、残りの行は最後まで処理される。

数値でない行を、先に If Not IsNumeric(...) で判定し、数値の行だけを ElseIf で比較している点がポイントである。
確認が終わったら、担当者つきサンプルデータを作る を、もう一度実行して、表を元に戻しておこう。
まとめ
今回は、表を1行ずつ処理して、条件に合う行を抽出する方法を学んだ。
For 行 = 2 To 最終行で、見出しの次の行から、最終行まで繰り返せる。ws.Cells(行, 列番号)で、1行ずつセルの値を読み取れる。- 繰り返しの中に
Ifを入れれば、条件に合う行だけを処理できる。 - 抽出した行は、元の行番号とは別の
書込行を使って、詰めて書き込む。 - 条件が複数あるときは
AndとOrを使い、混ぜるときは( )で囲む。 - 数値の列に文字が混ざっていると、エラーにならずに、文字の行が条件を満たしてしまう。
IsNumericで事前に確認する。
次回(第25回)は、表データの処理編の最終回として、処理の高速化に取り組む。
今回のように、1行ずつセルを読み書きする方法は、行数が増えると時間がかかる。
表を配列に一括で取り込んで、配列の上で処理し、結果を一括で書き戻す方法を学ぼう。
第15回で学んだ配列の知識も、ここで活きてくる。


コメント