はじめに

Excel VBAで都道府県ごとにデータを自動振り分けるVBAコードを作成したので、筆者自身の備忘録として記す。

1. このVBAコードが解決する課題

手作業で都道府県ごとにデータを分けるのは非効率だ。
大量のデータを一括で適切なシートに仕分けることで、以下の問題を解決できる。

✅ シート作成の自動化：都道府県ごとに手動でシートを作る手間を排除
✅ データ転記の高速化：バルク処理を用いて、1セルずつコピーする非効率さを回避
✅ ミスの削減：最終行を自動検出することで、手動入力ミスを防ぐ

では、どのようにコードを最適化していくのか、詳細を見ていこう。

2. コードの核心ポイント

以下のVBAコードでは、都道府県名をキーにしてデータを振り分け、必要に応じて新規シートを作成する。

Sub データ振り分け()
    Dim 元シート As Worksheet
    Dim 先シート As Worksheet
    Dim 最終行 As Long
    Dim i As Long
    Dim 都道府県名 As String
    Dim 対象行 As Long

    Set 元シート = ThisWorkbook.Worksheets("一覧表")
    最終行 = 元シート.Cells(元シート.Rows.Count, "B").End(xlUp).Row

    Application.ScreenUpdating = False

    For i = 3 To 最終行
        都道府県名 = 元シート.Cells(i, 2).Value

        ' シート存在確認と作成処理
        On Error Resume Next
        Set 先シート = ThisWorkbook.Worksheets(都道府県名)
        On Error GoTo 0

        If 先シート Is Nothing Then
            Set 先シート = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
            先シート.Name = 都道府県名
        End If

        ' 対象行の算出
        対象行 = 先シート.Cells(先シート.Rows.Count, "B").End(xlUp).Row + 1

        ' データ転記
        With 元シート
            先シート.Cells(対象行, 2).Resize(1, 4).Value = _
                Array(.Cells(i, 3).Value, .Cells(i, 4).Value, .Cells(i, 5).Value, .Cells(i, 6).Value)
        End With

        Set 先シート = Nothing
    Next i

    Application.ScreenUpdating = True
    MsgBox "データの振り分けが完了しました", vbInformation
End Sub

3. コードの改善点と最適化

このコードはシンプルで分かりやすいが、改善の余地もある。
特に、以下の点を見直せば、さらにスマートなコードになる。

(1) シート名の不正文字対策

Excelのシート名には / \ * ? [ ] などの特殊文字が使えない。
これらを置換する処理を追加すれば、エラーを未然に防げる。

都道府県名 = Replace(都道府県名, "/", "・")
都道府県名 = Replace(都道府県名, "\", "・")
都道府県名 = Replace(都道府県名, "*", "")
都道府県名 = Replace(都道府県名, "?", "")
都道府県名 = Replace(都道府県名, "[", "")
都道府県名 = Replace(都道府県名, "]", "")

(2) シート作成処理の改善

On Error Resume Next を使用するとエラーを無視してしまい、意図しない動作を見逃す可能性がある。
シートの存在チェックを関数化すると、より安全な処理ができる。

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(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        ws.Name = シート名
    End If

    Set シート取得または作成 = ws
End Function

こうすれば、メイン処理をスッキリと書ける。

Set 先シート = シート取得または作成(都道府県名)

(3) データ転記の最適化

現在のコードは Array() を使って複数のセルにデータをコピーしているが、
Resize ではなく Range を直接指定すると、可読性が向上する。

With 元シート
    先シート.Range("B" & 対象行 & ":E" & 対象行).Value = _
        Array(.Cells(i, 3).Value, .Cells(i, 4).Value, .Cells(i, 5).Value, .Cells(i, 6).Value)
End With

4. 改善後のコード

すべての改善点を反映すると、以下のようになる。

Sub データ振り分け()
    Dim 元シート As Worksheet, 先シート As Worksheet
    Dim 最終行 As Long, i As Long, 都道府県名 As String, 対象行 As Long

    Set 元シート = ThisWorkbook.Worksheets("一覧表")
    最終行 = 元シート.Cells(元シート.Rows.Count, "B").End(xlUp).Row

    Application.ScreenUpdating = False

    For i = 3 To 最終行
        都道府県名 = 元シート.Cells(i, 2).Value

        ' 不正文字の除去
        都道府県名 = Replace(都道府県名, "/", "・")
        都道府県名 = Replace(都道府県名, "\", "・")
        都道府県名 = Replace(都道府県名, "*", "")
        都道府県名 = Replace(都道府県名, "?", "")
        都道府県名 = Replace(都道府県名, "[", "")
        都道府県名 = Replace(都道府県名, "]", "")

        ' シート取得または作成
        Set 先シート = シート取得または作成(都道府県名)

        ' 対象行の算出
        対象行 = 先シート.Cells(先シート.Rows.Count, "B").End(xlUp).Row + 1

        ' データ転記
        With 元シート
            先シート.Range("B" & 対象行 & ":E" & 対象行).Value = _
                Array(.Cells(i, 3).Value, .Cells(i, 4).Value, .Cells(i, 5).Value, .Cells(i, 6).Value)
        End With
    Next i

    Application.ScreenUpdating = True
    MsgBox "データの振り分けが完了しました", vbInformation
End Sub

まとめ

業務で大量のデータ処理をするとき、ちょっとした最適化が作業時間の短縮につながる。
今後のVBA実装時に、ぜひ参考にしてほしい。