VBAでキーごとにシートに分ける簡単なサンプル

Excel業務あるあるシリーズ

仕事をしていると、「なんでこんなこと、やらなきゃならんのだ！！」という場面に遭遇します。

Excelのワークシートに書かれた値を１行ずつ、別の様式に転記するとか、テーブル的に作られたデータをキーごとに別シートに転記したりなど・・・。

そんな「Excel業務あるあるシリーズ」。

操作は難しくはないけど、時間がかかる。

関数ではどうにもならない。

そんなシーンを解決するためのコードサンプルを紹介していきたいと思います。

他のあるある

ExcelVBAで差し込み印刷もどきをやってみる - 適材適所

Excel VBAでシートの一覧を作成しハイパーリンクを作成して目次を作る - 適材適所

VBAでキーごとシートに分ける！！

一行目にデータ項目名があり、以降データレコードが続くような、テーブル的なデータを特定のキーごとにシートに分けたい。

私もこれまでそんな相談を何回か受けたことがあります。

多分、この手の作業を手動で行っている方は多いのではないかと思います。

ということで、第一弾は、「キーごとにシートに分ける」です。

サンプルデータ

こちらのサイトにお世話になります。

kazina.com

シンプルにするために、フィールドは名前と血液型の2つにします。

100件のレコードをCSV形式でダウンロードします。

ダウンロードしたファイルの拡張子をcsvに変更します。

このようなデータをサンプルに、血液型をキーに、シートに分けていきます。

csvのデータをあらかじめ、xlsm形式で名前を付けて保存しておきます。

VBAでキーごとシートに分ける処理の流れ

①血液型ごとのシートを準備する
②各レコードを走査して合致するシートに転記する

やり方は色々あるのですが、一番単純な正攻法でいきたいと思います。

VBAでキーごとシートに分けるコード

 

Sub sample()
    Const KEY_COL As Long = 2
    Const SHEET_NAME as String="dummy"

    '①血液型ごとのシートを準備する
    '①－１dummyシートの設定・最終行の取得
    Dim shDummy As Worksheet: Set shDummy = Worksheets(SHEET_NAME)
    Dim maxRow As Long: maxRow = shDummy.Cells(Rows.Count, KEY_COL).End(xlUp).Row
    Dim maxCol As Long: maxCol = shDummy.Cells(1, Columns.Count).End(xlToLeft).Column
    
    '①－２重複のないリストを作成
    Dim i As Long
    Dim coll As Collection: Set coll = New Collection
    Dim strKey As String
    For i = 2 To maxRow
        strKey = shDummy.Cells(i, KEY_COL)
        On Error Resume Next
        coll.Add strKey, strKey
        On Error GoTo 0
    Next i
    '①－３シートを作成
    Dim varItem As Variant
    Dim sh As Worksheet
    Dim col As Long
    For Each varItem In coll
        Set sh = Worksheets.Add
        '①－４同名のシートはない想定
        sh.Name = varItem
        '①－５フィールド名を書込む
        For col = 1 To maxCol
            sh.Cells(1, col) = shDummy.Cells(1, col)
        Next col
    Next varItem

    '②各レコードを走査して合致するシートに転記する
    Dim writeRow As Long
    For i = 2 To maxRow
        '②－１書き込み対象のシートを変数に格納する
        Set sh = Worksheets(shDummy.Cells(i, KEY_COL).Value)
        '②－２書き込み対象のシートの追記行を取得する
        writeRow = sh.Cells(Rows.Count, KEY_COL).End(xlUp).Row + 1
        '②－３各項目を書き込む
        For col = 1 To maxCol
            sh.Cells(writeRow, col) = shDummy.Cells(i, col)
        Next col
    Next i
End Sub

コードの解説

①血液型ごとのシートを準備する

①－１dummyシートの設定・最終行の取得

dummyシートの変数への格納と、最終の行と列を変数に格納しています。

①－２重複のないリストを作成

一見、とても奇妙なコードに見えるかも知れません。

ここでは「重複するキーを設定することができない」というコレクションの性質を利用して、重複のないリストを作成しています。

あまり使う機会がないかも知れませんが、VBAのコレクションはキーを設定することができます。

コレクションに重複したキーを設定しようとするとエラーが返るため、On Error Resume Next でそのエラーを無視します。

するとコレクション内に重複のないリストが作成されます。

①－３シートを作成

①－２で作成した重複のないリストをもとに、ワークシートを作成する処理です。

For each を使ってコレクションの要素に対してシートの作成を行っています。

For each で要素を取り出す際、割り当てる変数はオブジェクト型かバリアント型である必要があるため、varItemというバリアント型変数を使います。

①－４同名のシートはない想定

同名のシートがあると、エラーとなります。

エラー処理は組み込んでいないので、同名シートがある場合は、事前に削除しておく必要があります。

①－５フィールド名を書込む

新規にシートを作成したら、フィールド名をあらかじめ１行目に転記しておきます。

②各レコードを走査して合致するシートに転記する

dummyシートの２行目のレコードから順番に見ていきます。

②－１書き込み対象のシートを変数に格納する

あらかじめ定数KEY_COLで指定してある列の値をもとに転記先シートを特定し、シートを変数shに格納します。

②－２書き込み対象のシートの追記行を取得する

書き込み対象のシートの、最終行に１を足すことで、追記すべき行を取得しています。

②－３各項目を書き込む

あらかじめ取得している、maxCol変数には、フィールド数が格納されています。

dummyシートのフィールドの数だけ、レコードのフィールドを書き込み対象のシートに転記していきます。

カスタマイズする

定数だけ変更することで汎用的に使えるようにしています。

SHEET_NAMEは、データが書いてあるシート名です。

KEY_COLは振り分けるためのキーとなる列数です。

また、このサンプルでは処理速度は考慮していないため、レコード数が多い場合は注意が必要です。

処理速度を上げる場合は、画面の更新を止めたり、シートの値を配列に格納すれば十分かと思います。

終わりに

Excel業務あるあるシリーズ第一弾、キーごとにシートに分ける簡単なサンプルを紹介しました。

こういう類の作業は日本の事務職の中に蔓延っているはず・・・。

少しでもよくある業務の手間が改善されれば幸いです。

ここまでお読みいただき、ありがとうございました。