【エクセルマクロ】重複データを１行にまとめる：動画あり

エクセルマクロで、重複データを１行にまとめるVBAコードをご紹介します。

このページのマクロコードは、コピペで使えます。
ぜひ、お試しください。

重複データを１行にまとめる

以下のマクロを実行すると、重複している隣のデータを1つにまとめて転記します。

Sub 重複データをまとめる()

Dim i As Long
Dim j As Long
Dim LastRow As Long
Dim Buf As String

    '最終行を取得
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row

    '転記開始行
    j = 1

    Application.ScreenUpdating = False

    '1から最終行までループ
    For i = 1 To LastRow

        'B列の値を格納
        Buf = Buf & Cells(i, 2) & ","

        '現在の行と、次の行の値を比較
        If Cells(i, 1) <> Cells(i + 1, 1) Then

            'D列に転記
            Cells(j, 4) = Cells(i, 1)

            'E列に転記
            Cells(j, 5) = Left(Buf, Len(Buf) - 1)

            '次のループ前に事前処理
            Buf = ""
            j = j + 1
        End If
    Next i

    Application.ScreenUpdating = True

End Sub

マクロ実行前

A列を基準に、データを並べ替えておきます。

マクロ実行後

A列が重複していたらB列を結合し、1行にまとめて出力します。

重複データを１行にまとめる（応用）

以下のマクロを実行すると、重複データを結合して1行にまとめます。

Sub 重複データをまとめる()

Dim i As Long
Dim j As Long
Dim LastRow As Long
Dim Buf As String

    '最終行を取得
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row

    '転記開始行
    j = 1

    '1から最終行までループ
    For i = 1 To LastRow

        'B列の値を格納
        Buf = Buf & Cells(i, 3) & ","

        '現在の行と、次の行の値を比較
        If Cells(i, 1) & Cells(i, 2) <> Cells(i + 1, 1) & Cells(i + 1, 2) Then

            'E列・F列に転記
            Cells(j, 5) = Cells(i, 1)
            Cells(j, 6) = Cells(i, 2)

            'G列に転記
            Cells(j, 7) = Left(Buf, Len(Buf) - 1)

            '次のループ前に事前処理
            Buf = ""
            j = j + 1
        End If
    Next i

End Sub

マクロ実行前

A列とB列を基準に、データを並べ替えておきます。

マクロ実行後

A列とB列が重複していたら、C列を結合します。

 
 
この記事がお役に立ちますと幸いです。
 

【エクセルマクロ】重複データを自動操作：超便利１３選

...

kirinote.com

2022.06.04