重複セル値のマージ/削除

同じ値のセルを結合すると問題が発生します。 私は、列と行の量が異なるExcelファイルを受け取っているので、大量の行または列にマクロを設定することはできません。 私が持っているのはこのようなものです

最初の行はもちろんそれらの中にフィルタがあるヘッダ行です。 私が欲しいのはこのようなものであるべきです

だから私はまだすべての列で物事を並べ替えることができます（だからクールなバイクはまだ私に4行を表示します） それを行うことができて、シートのサイズ（時々数千行）から応答しないで、そしてすべてのシートのために手動で変更してセットアップする必要がないでしょうマクロまたはスクリプトがありますか？

ご協力ありがとうございます。

これが表示上の問題である場合は、単に条件付き書式を使用することができます。

規則は次のようになります。

=$C1=$C2

フォーマットは Number Format 以下のカスタムフォーマット ;;;

また、並べ替えた列に関係なく、キャッチフレーズは、上記の例のように、その上に表示される空白行にも適用されます。

このソートと条件付き書式設定の適用は、必要に応じてマクロで実行できます。

ただし、並べ替える必要があります。 tagline 同じキャッチフレーズを持つすべてのバイクをまとめておくために

このマクロは動作するはずです。

Public Sub merger()
    Application.DisplayAlerts = False
    Dim wkb As Workbook
    Dim wks As Worksheet
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("Sheet1")
    firstrow = 2
    lastcolumn = "Z"
    columnsortkey = "C"
    columnmerge = 3
    Columns("A:" & lastcolumn).Sort key1:=Range(columnsortkey & ":" & columnsortkey), Header:=xlYes
    theEnd = False
    thisrow = firstrow
    found = False
    Count = 0
    While theEnd = False
        firstCell = wks.Cells(thisrow, columnmerge)
        nextCell = wks.Cells(thisrow + 1, columnmerge)
        If firstCell = nextCell Then
            If found = False Then
                found = True
                mergerfirst = thisrow
                Count = Count + 1
            Else
                Count = Count + 1
            End If
        Else
            If found = True Then
                Range(Cells(mergerfirst, columnmerge), Cells(mergerfirst + Count, columnmerge)).Merge
                found = False
                Count = 0
            End If
        End If
        thisrow = thisrow + 1
        If firstCell = "" Then theEnd = True
    Wend
    Application.DisplayAlerts = True
End Sub

うまく機能させるには、VBA / Macrosを開いて ALT + F11 その後 このワークブック 新しいモジュールを挿入してコードを貼り付けます。