2024年10月7日 / 最終更新日時 : 2024年10月7日 alljapan Dictionary

A列でグループ化してB列のテキストを1つのセルにまとめる

以下はタイトルのサンプルマクロです。

Sub TransformData()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRow As Long
    Dim currentRow As Long
    Dim destRow As Long
    Dim projectName As Variant
    Dim persons As String
    Dim dict As Object

    ' 変換前のシートを設定
    Set wsSource = ThisWorkbook.Sheets("変換前")
    ' 変換後のシートを作成
    Set wsDest = ThisWorkbook.Sheets("変換後")
    wsDest.Range("A2:B" & wsDest.Cells(Rows.Count, 2).End(xlUp).Row).ClearContents


    ' 辞書オブジェクトを作成（重複しない案件名を管理）
    Set dict = CreateObject("Scripting.Dictionary")

    ' 変換前シートの最終行を取得
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

    ' データ変換のためのループを開始
    For currentRow = 2 To lastRow
        projectName = wsSource.Cells(currentRow, 1).Value
        persons = wsSource.Cells(currentRow, 2).Value
        
        ' 件名が辞書にない場合、追加
        If Not dict.exists(projectName) Then
            dict.Add projectName, persons
        Else
            ' 件名が辞書にある場合、氏名を追加
            dict(projectName) = dict(projectName) & ", " & persons
        End If
    Next currentRow

    ' 辞書の内容を変換後シートに出力
    destRow = 2
    For Each projectName In dict.keys
        wsDest.Cells(destRow, 1).Value = projectName
        wsDest.Cells(destRow, 2).Value = dict(projectName)
        destRow = destRow + 1
    Next projectName

    ' メッセージを表示
    MsgBox "データの変換が完了しました。"
End Sub

このマクロ TransformData は、Excelシートにあるデータを変換し、特定の形式で新しいシートに出力するために作成されています。以下にマクロの動作の詳細を説明します。

マクロの目的

変換前のデータ: 「変換前」シートには、件名と氏名が縦に並んでおり、件名が重複している可能性があります。
変換後のデータ: 「変換後」シートでは、件名ごとに1行だけ表示され、その件名に対応するすべての氏名が1つのセルにカンマ区切りでまとめられます。

1. 変数の宣言

Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim lastRow As Long
Dim currentRow As Long
Dim destRow As Long
Dim projectName As Variant
Dim persons As String
Dim dict As Object

wsSource: データが変換前に入力されているシート（「変換前」シート）。
wsDest: 変換後のデータを出力するシート（「変換後」シート）。
lastRow: 変換前シートの最終行（データがある行数）を記録する変数。
currentRow: 変換前のデータをループで処理する際に使用する行番号。
destRow: 変換後シートの書き込み対象となる行番号。
projectName: 件名（A列の値）を格納するための変数。
persons: 氏名（B列の値）を格納するための変数。
dict: 件名をキー、氏名を値として保存するための辞書（Scripting.Dictionary）オブジェクト。

2. シートの設定

Set wsSource = ThisWorkbook.Sheets("変換前")
Set wsDest = ThisWorkbook.Sheets("変換後")
wsDest.Range("A2:B" & wsDest.Cells(Rows.Count, 2).End(xlUp).Row).ClearContents

wsSource に「変換前」シート、wsDest に「変換後」シートを設定します。
ClearContents で、変換後シートのA列とB列の既存データをクリアします。

3. 辞書オブジェクトの作成

Set dict = CreateObject("Scripting.Dictionary")

dict は、件名を一意に管理するための辞書オブジェクトです。件名が重複している場合、氏名をカンマ区切りで結合して保持します。

4. 変換前シートの最終行を取得

lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

lastRow で、変換前シートのA列に入力された最終行の番号を取得します。これにより、どこまでデータを処理するかを決定します。

5. データ変換ループ

For currentRow = 2 To lastRow
    projectName = wsSource.Cells(currentRow, 1).Value
    persons = wsSource.Cells(currentRow, 2).Value
    
    ' 件名が辞書にない場合、新規追加
    If Not dict.exists(projectName) Then
        dict.Add projectName, persons
    Else
        ' 件名が既に辞書にある場合、氏名をカンマ区切りで追加
        dict(projectName) = dict(projectName) & ", " & persons
    End If
Next currentRow

For ループは、2行目から最終行まで繰り返します。
projectName にはA列（件名）のデータを、persons にはB列（氏名）のデータを取得します。
件名が辞書に存在しない場合、辞書に追加します。すでに存在する場合は、氏名をカンマ区切りで追加します。

6. 辞書の内容を「変換後」シートに出力

destRow = 2
For Each projectName In dict.keys
    wsDest.Cells(destRow, 1).Value = projectName
    wsDest.Cells(destRow, 2).Value = dict(projectName)
    destRow = destRow + 1
Next projectName

辞書に保存された件名と氏名を、変換後シートのA列とB列に出力します。
destRow は出力する行を指し、1行ずつ増やしていきます。

7. 完了メッセージの表示

MsgBox "データの変換が完了しました。"

処理が終了したら、メッセージボックスでユーザーに通知します。

処理の流れまとめ

「変換前」シートのデータを読み込み、件名と氏名を辞書に格納します。件名が重複する場合は、氏名をカンマで結合して1つのセルにまとめます。
「変換後」シートに出力し、件名ごとに1行にまとめて表示します。
最後に、変換処理が完了したことを知らせるメッセージを表示します。

このマクロは、件名ごとに氏名をまとめる際に便利です。氏名が複数いる場合、件名を一度だけ表示し、その件名に関連するすべての氏名を1行に結合します。

使用例

以下の「変換前」シートにて

マクロを実行すると、「変換後」シートには、以下のようになります。

Follow me!

カテゴリー: Dictionary、Excel、VBA、マクロ