【VBA编程】将有相同值的几条数据行合并成一行

Sub 合并同类项()

 Dim i&, j&, Arr, Brr, Dic As Object

 Set Dic = CreateObject("Scripting.Dictionary")

 Arr = Range(Cells(1, "T"), Cells(Rows.Count, "T").End(xlUp))

 Brr = Arr

 ReDim Brr(0 To UBound(Arr) - 1, 1 To 3)

 For i = 1 To UBound(Arr)

  If Not Dic.Exists(Arr(i, 1)) Then

   Dic(Arr(i, 1)) = Dic.Count

   j = Dic(Arr(i, 1))

   Brr(j, 1) = Arr(i, 1): Brr(j, 2) = Cells(i, "AA"): Brr(j, 3) = Cells(i, "AB")

  Else

   j = Dic(Arr(i, 1))

   Brr(j, 2) = Brr(j, 2) & "," & Cells(i, "AA"): Brr(j, 3) = Brr(j, 3) & "," & Cells(i, "AB")

  End If

 Next i

 [AI1].Resize(Dic.Count, 3) = Brr

 Set Dic = Nothing

End Sub

For x= Cells(65536,2).End(xlup).Row to 2

If Cells(x,2)=Cells(x+1,2) Then

Cells(x+1,3)=cells(x,3)+Cells(x+1,3)

Cells(x,2).EntireRow.Delete

end if

next

---