【Excel VBA】行単位での重複チェックと削除について

Excel2016で、電話番号とその属性が最大で5つまで登録されている一覧があります。
同一人で、同じ電話番号が複数登録されている場合は、ダブっている電話番号とその属性を削除して、その分、左に詰めたいと考えています。（下記イメージを参照）

この処理をVBAで行う場合はどのようなコードになるか、アドバイスを頂けますと幸いです。
よろしくお願いいたします。

＜処理前＞
氏名 電話番号1 電話番号1の属性 電話番号2 電話番号2の属性 電話番号3 電話番号3の属性 ・・・
高杉 慎太郎 03-1234-5678 仕事 090-1111-2222 携帯 03-1234-5678 会社
藤田 由紀子 045-435-0033 会社 080-3434-9999 携帯 080-3434-9999 仕事
三村 健一 048-476-3434 自宅 048-476-3434 仕事 070-8787-6235 仕事

＜処理後＞
氏名 電話番号1 電話番号1の属性 電話番号2 電話番号2の属性 電話番号3 電話番号3の属性 ・・・
高杉 慎太郎 03-1234-5678 仕事 090-1111-2222 携帯
藤田 由紀子 045-435-0033 会社 080-3434-9999 携帯
三村 健一 048-476-3434 自宅 070-8787-6235 仕事

No.1 回答者： googoo900 回答日時： 2018/04/23 00:59

こんな感じでしょうか。

データが例のようにはいっている前提です。
電話番号は6つ以上でもできます。

Sub Macro1()
Dim endrow
Dim endcol
Dim i, j, k
endrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To endrow
endcol = Cells(i, Columns.Count).End(xlToLeft).Column
For j = 2 To endcol - 3 Step 2
For k = 4 To endcol - 1 Step 2
If j = k Then k = k + 2
If Cells(i, k) = "" Then Exit For
If Cells(i, k) = Cells(i, j) Then
Range(Cells(i, k), Cells(i, k + 1)).Delete Shift:=xlToLeft
k = k - 2
endcol = Cells(i, Columns.Count).End(xlToLeft).Column
End If
Next k
Next j
Next i
End Sub