◆重複行を削除する

  同じ項目が複数行にあるときに、1行にまとめたいと思いますよね。

  その方法のサンプル紹介です。

  重複している項目数を知りたい場合は、
  フィルタ オプションを使用して、重複しない Item を取得する を参考にしてください。

  まず、最初に項目で並べ替え(ソート)しておきます。

  並べ替えのコードは、１から記述するのではなくて、やりたい事をマクロ記録させて、
  記録されたコードを使います。

  そして、汎用性があるように一部修正します。この方が、使えるコードを早く記述で
  きます。

  並べ替えに限らず、一つひとつコードを記述するよりも、機能ごとにマクロ記録を
  利用して、記録されたコードを組み立てる方が簡単にマクロを記述できます。

  行の削除は、

          Rows(Format(RowCount + 1)).Delete

  でできます。

  同じ項目を1行にまとめる時に、数量等の合計の計算をする場合もあると思います。
  サンプルコード のコメントの部分を任意に改造して使ってください。

Sub merge2()

    Dim RowCount       As Integer
    Dim RefColumn, sta As String
    
    
    RefColumn = "B"
    '重複している項目がある列を入力してもらいます
    RefColumn = _
            InputBox("基準の列を入力してください", "基準列の入力", RefColumn)
    
    sta = "1"
    sta = InputBox("開始の行を入力してください", "開始行の入力", sta)
    
    '基準列でソートしておきます
    Range(RefColumn & sta).Select
    Selection.CurrentRegion.Select
    Selection.sort Key1:=Range(RefColumn & sta), Order1:=xlAscending, _
    Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, SortMethod:=xlPinYin
    
    Range(RefColumn & sta).Select
    
    '文字を数字に変換
    RowCount = Val(sta)
    
    '空白行を検出するまで、下に向かってループ
    While Not Range(RefColumn & Format(RowCount + 1)) = ""
    
        '重複しているかどうかのチェック
        If Range(RefColumn & Format(RowCount)) = _
                               Range(RefColumn & Format(RowCount + 1)) Then
                                                              
        
'          重複行を削除するだけではなく、任意の列の値を足し算する等も
'          あるでしょう。任意に改造してください
'          Range("D" & Format(RowCount)) = _
'          Range ("D" & Format(RowCount)) + Range("D" & Format(RowCount + 1))
'

            '行の削除
            Rows(Format(RowCount + 1)).Delete
        Else
            RowCount = RowCount + 1
        End If
    Wend
    
End Sub