【VBA】複数列重複の場合、項目を纏めた上で、重複排除したい。

Question

本サイトでは、いつも教えて頂き、感謝をしております。
さて、本日も教えて頂きたく。
よろしくお願いします。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
■　やりたい事。
下記の様なシートを編集しております。（実際は、もっと行数が多いです。）
B列にメーカー名が入っており、C列とD列が製品のSpecとなっております。
下表では、DellとNECのCPU＆HDD容量が同一なので、表全体を見やすくする為にも、
Dell/NECで行を纏めたいと思います。

普通に考えて、RemoveDuplicatesメソッドで作ったのですが、下記の様なコードだと、
Dell/NECになるのではなく、NECの行が単に消えてしまいます。（当たり前ですが。）

---

Public Sub deplicateDelete_test()

Sheets("Sheet1").Select
Range("B2").CurrentRegion.RemoveDuplicates Columns:=Array(2, 3), Header:=xlNo

Range("B2").Select
End Sub

---

おそらく、RemoveDuplicatesメソッドを動かす前に、「B列とC列が同一ならば、メーカー名を"/"で結合する。」と言う処理が必要なのでしょうが、どうしても分かりません。
自力で出来ると思ったのですが、ネットを探しても、類似事例がなく、
また、質問をさせて頂く次第です。
よろしくお願いします。

Answer 1

おそらくRemoveDuplicatesではいきなり重複行が削除されてしまうので、ご希望のセルの値の結合はできないと思われます。
面倒ですが自力で1行ずつ値をチェックして処理していくしかないでしょう。
具体的には、2行目のB列C列と同じ行が3行目～最終行までにあるかチェックする。
同じ行があれば見つけたA列の値を2行目のA列に結合する。
見つけた行は削除する。
最終行まで行い、次は3行目について同じことを行う。
というのを最終行まで行えばOKです。

Dim r As Integer
Dim r2 As Integer
r = 2
Do While Cells(r, 1).Value <> ""
    r2 = r + 1
    Do While Cells(r2, 1).Value <> ""
        If Cells(r, 2).Value = Cells(r2, 2).Value And Cells(r, 3).Value = Cells(r2, 3).Value Then
            Cells(r, 1).Value = Cells(r, 1).Value & "/" & Cells(r2, 1).Value
            Rows(r2).Delete
        Else
            r2 = r2 + 1
        End If
    Loop
    r = r + 1
Loop

Comments

[yujin1202]

早速の御回答をありがとうございます。
解決出来ました！
本当に、ありがとうございました。

＝＝＝＝＝＝＝＝＝＝＝＝
＞面倒ですが自力で1行ずつ値をチェックして処理していくしかないでしょう。

「カッコ良くできない。」、「地道に一行ずつやるしかない。」との説明は、非常にありがたかったです。こうした「生きたコメント」を聞きたかったです。
コードも、とても綺麗ですね。（私でも一覧して、理解できました。）
ありがとうございました。
ベストアンサーとさせて頂きます。