2025/01/19

【コード掲載】重複した項目は1行にまとめて
複数のシートを統合するマクロ

Excel / VBA

こんにちは、てつをです。複数のシートにある企業データを、重複した行は統合しながら1つのシートにデータをまとめるマクロを作成していきたいと思います。本業でビジネス戦略を考えていく中で、ある情報プラットフォームから企業情報を取得しているのですが、Excelでデータを取得するとある項目毎に企業リストが取得できます。例えば、ある分野Aに関連した特許数のリストなどが取得できます。しかし、戦略を考える上ではある分野Aだけでなく分野B、分野Cの情報も比較していく必要があります。すると、分野ごとにExcelシートができていくイメージなので、これらのシートを1枚にまとめて可視化したいなと思ったのが今回のマクロ作成のきっかけでした。後程、今回の設定については詳しくご紹介します！ 

目次

1. 今回実施したいこと【複数のシートを統合・社名が重複している行は1行に統合】

2. マクロの実行に向けた準備と実行結果

3. マクロ（VBAコード）の詳細説明

１．今回実施したいこと【複数のシートを統合・社名が重複している行は1行に統合】

今回の設定について

今回は、企業分析をしている際のデータの集計の場面となります。以下の様に、企業の特許取得数のリストが特許ごとにシート別にまとめられているとします。特許A、特許B、特許Cそれぞれが別々のシートにまとめられていることがわかるかと思います。この状態から、1つのシートで結果をまとめて見れるようにしていこうというのが今回の主題になります。

今回、ただ単にシートの情報を別の集計シートにコピーしてくだけだと、以下のサンプルの「あいう株式会社」や「きくけ株式会社」の様に、同じ企業名の行が複数できてしまうかと思います。（そもそも、シートごとに特許数をコピーする列も変えないといけないのでコピーだけでも若干めんどくさいです。。。） 

そこで、同じ企業の行は1行にまとめつつ、1つのシートに統合していくマクロを今回は作成してきます。マクロが完成すると、イメージとしては以下の様に同じ企業は行が1つにまとめられた集計シートが一瞬で出来るイメージになります。 

今回のサンプルでは、各シートに企業数が３つずつしか載っていないので、手作業でも問題なく集計シートは作成できますが、これが各シート50社ずつ、10シートとかになると、そもそも重複した企業を探すだけでもかなりの時間を費やすことになりますし、きっと見落としも何か所か出てきてしまうのではないかと思います。

では、次の章で実際にマクロを動かしてみましょう！

２．マクロの実行に向けた準備と実行結果

マクロの準備

まずは、今回のサンプル向けに作成したマクロを以下に載せます。今回とサンプルと同じ列数であれば、皆様のExcelでもすぐご利用いただけますが、おそらく管理する項目などはそれぞれ変わってくると思うので、その場合は次の章でマクロの詳細解説をしますのでそちらを見ながらマクロの編集を行っていただければと思います。 

Sub ConsolidateData()
    Dim ws As Worksheet
    Dim masterSheet As Worksheet
    Dim lastRow As Long
    Dim masterRow As Long
    Dim found As Range
    Dim columnOffset As Long
    
    ' 統合シートを作成
    Set masterSheet = ThisWorkbook.Sheets.Add
    masterSheet.Name = "統合"
    masterSheet.Range("A1:C1").Value = Array("企業名", "業界")
    
    ' 列のオフセットとマスター行の初期化
    columnOffset = 3
    masterRow = 2
    
    ' 各シートのデータを統合
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> masterSheet.Name Then
            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
            If lastRow > 1 Then ' データが存在する場合のみ処理
                ' シート名を1行目に追加
                masterSheet.Cells(1, columnOffset).Value = ws.Name
                
                For i = 2 To lastRow
                    Set found = masterSheet.Columns(1).Find(ws.Cells(i, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
                    If Not found Is Nothing Then
                        ' 企業名が見つかった場合、特許数を追加
                        masterSheet.Cells(found.Row, columnOffset).Value = ws.Cells(i, 3).Value
                    Else
                        ' 新しい企業名の場合、新しい行を追加
                        masterSheet.Cells(masterRow, 1).Resize(1, 2).Value = ws.Cells(i, 1).Resize(1, 2).Value
                        masterSheet.Cells(masterRow, columnOffset).Value = ws.Cells(i, 3).Value
                        masterRow = masterRow + 1
                    End If
                Next i
                
                ' 次のシートのために列を移動
                columnOffset = columnOffset + 1
            End If
        End If
    Next ws
End Sub

このマクロを貼り付けていただければ準備OKです。マクロの貼り付ける場所については、以前の記事と同じくThis Workbookになりますので、貼り付け場所がわからない方はこちらもご覧ください。【最新】ExcelマクロでOutlookのメールを送信者（差出人）指定して送る方法｜VBAコード掲載

マクロの実行結果

では、マクロの実行結果を見てみましょう。結果は以下になります。 

このように、各シートの情報が１つの統合シートという新しいシートにまとめられました。また、例えば一番上のあいう株式会社を見てみると、特許Aと特許Bがちゃんと1行にまとまっていますね。ただコピーするだけだと2行に分かれてしまうと思うので、かなり有用なマクロになっているかなと思います！ 

マクロを実行するうえでの注意点 

1点、マクロを実行するうえでの注意点があります。各シートに集計している企業名は同じ表現に統一してください。例えば、あいう株式会社とあいう(株)のように同じ企業を別の書き方で書いてしまうと、同じ企業と判定されず行が2行に分かれてしまいますので、同じ企業は必ず同じ表現で書くようにしましょう。 

３．マクロ（VBAコード）の詳細説明

では、ここからは１つ１つ細かくマクロを見ていきたいと思います。最初の変数の定義部分については説明を割愛させていただきます。 

統合シートを作成

    ' 統合シートを作成
    Set masterSheet = ThisWorkbook.Sheets.Add
    masterSheet.Name = "統合"
    masterSheet.Range("A1:C1").Value = Array("企業名", "業界")

新しく、統合シートを作成します。

3行目に新たに作るシート名、4行目に各シートにまとめられている企業情報を入力します。もし、企業名、業界以外にも売上とか従業員数とか項目を増やしたい場合は、4行目に追記していただければと思います。

列のオフセットとマスター行の初期化

    ' 列のオフセットとマスター行の初期化
    columnOffset = 3
    masterRow = 2

ここでは、統合シートにデータを転記する際、最初のデータをどこへ転記するかを設定しています。例えば今回の例ですと、特許数をどこに転記するかになるので、列（Column）は3列目から、行（Row）は2行目からになるので、上記のような設定となっています。もし、転記する場所が今回と異なっている場合はこちらも修正をお願いします。

各シートのデータを統合 

各シートの統合部分については少し長くなってしまうので、スクリプト内に説明を加えました。 

    ' 各シートのデータを統合
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> masterSheet.Name Then
            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
            If lastRow > 1 Then ' データが存在する場合のみ処理
                ' シート名を1行目に追加
                masterSheet.Cells(1, columnOffset).Value = ws.Name
                
                For i = 2 To lastRow
                    Set found = masterSheet.Columns(1).Find(ws.Cells(i, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
                    If Not found Is Nothing Then
                        ' 企業名が見つかった場合、特許数を追加
                        masterSheet.Cells(found.Row, columnOffset).Value = ws.Cells(i, 3).Value
                    Else
                        ' 新しい企業名の場合、新しい行を追加
                        masterSheet.Cells(masterRow, 1).Resize(1, 2).Value = ws.Cells(i, 1).Resize(1, 2).Value
                        masterSheet.Cells(masterRow, columnOffset).Value = ws.Cells(i, 3).Value
                        masterRow = masterRow + 1
                    End If
                Next i
                
                ' 次のシートのために列を移動
                columnOffset = columnOffset + 1
            End If
        End If
    Next ws

変更が想定される箇所は以下です。

・各シートの転記するセルの場所

今回は各シートの3行目に特許数があるので、その値をコピーするために〇行目にws.Cells(i, 3)と書いてあります。こちらは、例えば皆様が集計している数値は3行目でなく5行目に記載されているのであれば、ws.Cells(i, 5)と変更いただければと思います。

・Resize(1, 2)

Resize(1, 2)はVBAで使用されるメソッドで、セルの範囲を指定した行数と列数に変更するために使います。具体的には、このコードは1行2列に範囲を変更することを意味します。例を以下に記載します。

Range(“A1”).Resize(1, 2).Value = “Test”

こちらを実行することで、A1とB1に”Test”という値が入力されます。

今回は、企業名と業界の２つの項目を転記しているため、Resize(1,2)と書いていますが、例えば売上という項目を加える場合はこちらもResize(1,3)と変更していただければと思います。

 

今回の記事は以上となります。ご質問やExcel作成のご依頼がございましたら是非ご連絡下さい。

 

以上

Excel VBA 業務効率化

• facebook
• Tweet
• hatebu
• Share
• Read Later