Excel VBAでCSVを検索して一致するデータの行を抽出する

大量の行がある CSV を扱っていると、その中から特定のデータを検索して別シートにデータを抽出したいという事があります。これは結構多くのニーズがあると思うのですが Excel でパッと簡単にできる機能も関数もないみたいです。

やりたい事を図示すると、上図のように数字のコードでデータを検索して、一致するものから順番に抽出したいという事です。

これを実現するには VBA でマクロを組むしかないようです。

改善前のコード

Dim count
count = 2
For i = 1 To Sheets(2).UsedRange.Rows.count
    For j = 1 To Sheets(1).UsedRange.Rows.count
       If Sheets(2).Cells(i, 1).Value = Sheets(1).Cells(j, 8) Then
           Sheets(1).Activate
           Sheets(1).Range(Cells(j, 1), Cells(j, 30)).Select
           Selection.Copy
           Sheets(3).Activate
           Sheets(3).Cells(count, 1).Select
           ActiveSheet.Paste
           count = count + 1
       End If
    Next
Next

初心者の頃に書いていたコードです。マクロの記録を駆使してわからないなりに何とか動作するようになったものです。

主要部分以外省略していますが、シート1には読み込んだ CSV があり、シート2には検索に使うデータが入っています。シート3には抽出したデータを順番に並べていきます。

UsedRange.Rows.count はシートの最終行数を取得しています。Cells(j, 8) の8の部分は元データの検索列に変えてください。

ご覧の通り、人間の動作をそのままマクロにしたコードで、セルを選択してコピーペーストしています。しかし、これはプログラム的には凄く遅いです。select や Activate を使うと圧倒的に遅くなってしまうのです。

改善後のコード

Select を使わないようにコードを改善しました。これだけで印象的には10倍は早くなっている気がします。

Dim count
count = 2
For i = 1 To Sheets(2).UsedRange.Rows.count
    For j = 1 To Sheets(1).UsedRange.Rows.count
       If Sheets(2).Cells(i, 1).Value = Sheets(1).Cells(j, 8) Then
           For k = 1 To Sheets(1).Usedrange.Columns.count
              Sheets(3).Cells(count, k).Value = Sheets(1).Cells(j, k)
           Next
       count = count + 1
       End If
   Next
Next

行数も少なくなって見やすくなりました。違いはセルを範囲指定してコピーするという事をやめて、セル一つずつに値を代入しています。その為 for 文が3つの入れ子になっています。