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

2025-05-20 00:47:16
推荐回答(1个)
回答1:

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