第壹行標題，數據從第2行開始。
Sub Macro1()
Dim r As Long
Dim i As Long
Dim spec1 As New Collection
Dim spec2 As New Collection
Dim temp
Dim str1 As String
Dim row0 As Integer
On Error Resume Next
r = Range("A65536").End(xlUp).Row
For i = 2 To r
temp = Cells(i, 2)
If temp > Cells(i, 3) Then
Cells(i, 2) = Cells(i, 3)
Cells(i, 3) = temp
End If
str1 = Str(temp)
spec1.Add Cells(i, 3), str1
If Err.Number = 457 Then
Err.Clear
row0 = spec2(str1)
Cells(row0, 1) = Cells(row0, 1) & "&" & Cells(i, 1)
Cells(row0, 4) = Cells(row0, 4) + Cells(i, 4)
Rows(i).Delete
i = i - 1
Else
spec2.Add i, str1
End If
If Cells(i, 1) = "" Then Exit For
Next i
For i = 1 To spec1.Count
spec1.Remove 1
spec2.Remove 1
Next i
End Sub