【ExcelVBA・マクロ】1枚のシートをカテゴリごとに別シートへ分割する方法

1枚のシートをカテゴリごとに別シートへ分割する方法 ExcelVBA

大量のデータが入った1枚のシートを、部署別や拠点別に分けて保存し直す作業に時間を取られていませんか? フィルタをかけてコピーし、新しいシートを作って貼り付ける……。この繰り返し作業は、VBAで自動化するのに最適なタスクです。

今回は、指定した列の値を元に、自動でシートを生成してデータを振り分けるコードを紹介します。

スポンサーリンク
スポンサーリンク

今回紹介するコードの動作イメージ

  1. 元になるデータシートの特定の列(例:B列の部署名)を確認します。
  2. 重複を除いたカテゴリ(部署名)のリストを内部的に作成します。
  3. カテゴリごとの新しいシートを自動で作ります。
  4. 各カテゴリに一致するデータだけを、それぞれのシートに転記します。

それでは、具体的なコードを見ていきましょう。

シートを分割して振り分けるVBAコード

このコードは、A列から始まるデータ一覧を対象としています。分割したい基準の列が何列目かを指定して実行してください。

VBA

Sub SplitSheetByCategory()
    Dim wsMaster As Worksheet
    Dim wsNew As Worksheet
    Dim lastRow As Long
    Dim categoryCol As Integer
    Dim categoryList As Collection
    Dim cell As Range
    Dim item As Variant
    Dim targetValue As String
    
    ' --- 設定項目 ---
    ' 1. 分割の基準にする列番号(例:B列なら 2)
    categoryCol = 2
    
    ' 2. 元データがあるシート名
    Set wsMaster = ThisWorkbook.Sheets("Sheet1")
    
    ' 画面更新停止
    Application.ScreenUpdating = False
    
    ' 元データの最終行を取得
    lastRow = wsMaster.Cells(wsMaster.Rows.Count, categoryCol).End(xlUp).Row
    
    ' 3. 重複しないカテゴリリストを作成
    Set categoryList = New Collection
    On Error Resume Next
    For Each cell In wsMaster.Range(wsMaster.Cells(2, categoryCol), wsMaster.Cells(lastRow, categoryCol))
        If cell.Value <> "" Then
            categoryList.Add cell.Value, CStr(cell.Value)
        End If
    Next cell
    On Error GoTo 0
    
    ' 4. カテゴリごとにシートを作成・転記
    For Each item In categoryList
        targetValue = CStr(item)
        
        ' 既存のシートがあるか確認し、なければ作成
        On Error Resume Next
        Set wsNew = ThisWorkbook.Sheets(targetValue)
        If wsNew Is Nothing Then
            Set wsNew = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            wsNew.Name = targetValue
        Else
            wsNew.Cells.Clear
        End If
        On Error GoTo 0
        
        ' オートフィルタで抽出してコピー
        wsMaster.Range("A1").AutoFilter Field:=categoryCol, Criteria1:=targetValue
        wsMaster.Range("A1").CurrentRegion.Copy Destination:=wsNew.Range("A1")
        
        ' フィルタ解除
        wsMaster.AutoFilterMode = False
        
        ' 列幅を自動調整
        wsNew.Columns.AutoFit
        
        Set wsNew = Nothing
    Next item
    
    wsMaster.Activate
    Application.ScreenUpdating = True
    
    MsgBox "シートの分割が完了しました!", vbInformation
End Sub

コードのポイント解説

1. Collectionオブジェクトで重複を排除

New Collection を使い、カテゴリ名をキーとして登録することで、重複のないリストを自動的に作成しています。これにより、どんな名称がいくつあっても柔軟に対応できます。

2. AutoFilter(オートフィルタ)の活用

1行ずつループして判定するのではなく、オートフィルタで一括抽出してコピーする方法を採用しています。データ量が多い場合でも高速に処理が終わります。

3. シートの存在チェック

既に同じ名前のシートがある場合は、新しく作らずに「中身をクリアして上書き」するように処理を分岐させています。これにより、二重にシートが作られるエラーを防ぎます。

4. CurrentRegionによる範囲自動取得

データの範囲を CurrentRegion で取得しているため、列が増えたり行が増えたりしても、コードを書き換えることなくそのまま使えます。

このマクロの使い方

  1. 分割したいデータが入っているExcelファイルを開きます。
  2. Alt + F11 を押してVBEを開き、標準モジュールにコードを貼り付けます。
  3. コード内の categoryCol = 2 の数字を、分割基準にしたい列番号に変更します。
  4. マクロを実行します。
  5. カテゴリ名のついたシートが自動的に追加され、データが振り分けられます。

カスタマイズのヒント

分割したシートを別々のブックとして保存したい場合

現在は同じブック内にシートを増やしていますが、転記した後に wsNew.Move と記述することで、新しいブックとして独立させることも可能です。

並び順を指定したい場合

このコードでは、元データの上から順にシートが作成されます。特定の順番にしたい場合は、あらかじめ元データをその基準でソートしてから実行するのが一番簡単です。

まとめ

データの分割作業は、手動で行うと「貼り付け忘れ」や「シート名の入力ミス」などのヒントがつきまといます。 VBAであれば正確かつ迅速に処理できるため、浮いた時間をデータの分析や資料作成に充てることができますね。

スポンサーリンク
スポンサーリンク
ExcelVBA
いがぴをフォローする

コメント

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