【Excel VBA入門 第24回】表を1行ずつ処理しよう!条件に合う行を別シートに抽出・転記する

スポンサーリンク
Excel VBA

イントロダクション

前回(第23回)は、End(xlUp) を使って、表の最終行を取得する方法を学んだ。最終行が分かれば、行数が変わる表でも、最後のデータまでを過不足なく扱える。

今回は、その最終行を使って、表を1行ずつ処理する。
さらに、条件に合う行だけを、別のシートに抜き出して転記するマクロを作る。
「売上が1,000円以上の行だけを取り出したい」「特定の担当者の行だけを集めたい」といった作業は、実務でもよくある。

表データの処理編は、次の3回構成である。

  • 第23回:データの最終行を取得する
  • 第24回(今回):表を1行ずつ処理する(条件に合う行を抽出して転記する)
  • 第25回:配列を使って、処理を高速化する

【準備】担当者つきのサンプルデータを用意する

今回は、第23回の表に「担当」の列を加えて、行数も増やした、次の表を使う。シート名は、第23回と同じ「売上データ」である。

ABCD
1日付商品売上担当
210/1りんご1200田中
310/2みかん800佐藤
410/3ぶどう1500田中
510/4バナナ600鈴木
610/5メロン2000佐藤
710/6いちご900田中
810/7もも1100鈴木
910/8りんご1300佐藤
1010/9みかん700田中
1110/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 Sub

And は 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 Sub

C4が文字のままなら、「4行目の売上が数値ではありません。」と表示され、その行を飛ばして、残りの行は最後まで処理される。

数値でない行を、先に If Not IsNumeric(...) で判定し、数値の行だけを ElseIf で比較している点がポイントである。
確認が終わったら、担当者つきサンプルデータを作る を、もう一度実行して、表を元に戻しておこう。

まとめ

今回は、表を1行ずつ処理して、条件に合う行を抽出する方法を学んだ。

  • For 行 = 2 To 最終行 で、見出しの次の行から、最終行まで繰り返せる。
  • ws.Cells(行, 列番号) で、1行ずつセルの値を読み取れる。
  • 繰り返しの中に If を入れれば、条件に合う行だけを処理できる。
  • 抽出した行は、元の行番号とは別の 書込行 を使って、詰めて書き込む。
  • 条件が複数あるときは And と Or を使い、混ぜるときは ( ) で囲む。
  • 数値の列に文字が混ざっていると、エラーにならずに、文字の行が条件を満たしてしまう。IsNumeric で事前に確認する。

次回(第25回)は、表データの処理編の最終回として、処理の高速化に取り組む。
今回のように、1行ずつセルを読み書きする方法は、行数が増えると時間がかかる。
表を配列に一括で取り込んで、配列の上で処理し、結果を一括で書き戻す方法を学ぼう。
第15回で学んだ配列の知識も、ここで活きてくる。

コメント

タイトルとURLをコピーしました