如何用公式将EXCEL中相同项目的结果合并到同一单元格中——急求

Question

2406011572 205件20261334
2406011572 52件20261335
2406011572 1件63473026
2406011573 1件63086088

比如以上数据，如何合并成以下形式
2406011572 205件20261334,52件20261335，1件63473026
2406011573 1件63473026
2406011573 1件63086088
求VBA大神赐个代码，感谢！

Answer 1

先排序把相同的用下面宏可以连在一起了。

Sub 单元格内容连接()
Dim my As Range, Response, bd As String, my1 As String, i As Long
 i = 1
Set my = Application.InputBox(Prompt:="请选要连接单元格区域", Type:=8)
Response = MsgBox("是否要换行？", vbYesNo)
If Response = vbYes Then    ' 用户按下“是”。
   Response = MsgBox("是否要加标点？", vbYesNo)
   If Response = vbYes Then
      bd = Application.InputBox(Prompt:="请输入标点符号", Type:=2)
     For Each c In my
      If i = 1 Then
        If c.Value <> "" Then my1 = c.Text & bd: i = i + 1
      Else
          If c.Value <> "" Then my1 = my1 & vbLf & c.Text & bd: i = i + 1
       End If
     Next c
   Else
   For Each c In my
      If i = 1 Then
        If c.Value <> "" Then my1 = c.Text: i = i + 1
      Else
          If c.Value <> "" Then my1 = my1 & vbLf & c.Text: i = i + 1
       End If
     Next c
   End If
Else    ' 用户按下“否”。
       Response = MsgBox("是否要加标点？", vbYesNo)
   If Response = vbYes Then
      bd = Application.InputBox(Prompt:="请输入标点符号", Type:=2)
     For Each c In my
      If i = 1 Then
        If c.Value <> "" Then my1 = c.Text & bd: i = i + 1
      Else
          If c.Value <> "" Then my1 = my1 & c.Text & bd: i = i + 1
       End If
     Next c
   Else
   For Each c In my
      If i = 1 Then
        If c.Value <> "" Then my1 = c.Text: i = i + 1
      Else
          If c.Value <> "" Then my1 = my1 & c.Text: i = i + 1
       End If
     Next c
   End If
End If
  Set my = Application.InputBox(Prompt:="内容连接完成请选单元格输出", Type:=8)
  my = my1

End Sub

追问

大佬，这个不能识别前面一个单元格的相同项啊。需要的是A列所有相同单元格的B列的数据集中在一个单元格中提现，

Answer 2

没有那么复杂，直接做一个透视表，然后在透视边中选求和就好了，透视表做法可百度

Answer 3

通过代码可以实现。追问

VBA么？可以给一下解决办法么？谢谢~

Answer 4

Sub s()
arr = UsedRange
UsedRange.ClearContents
Set d = CreateObject("scripting.dictionary")
c = 1
For i = 1 To UBound(arr)
If d.exists(arr(i, 1)) Then
Cells(d(arr(i, 1)), 2) = Cells(d(arr(i, 1)), 2) & "," & arr(i, 2)
Else
d(arr(i, 1)) = c
Cells(c, 1) = arr(i, 1)
Cells(c, 2) = arr(i, 2)
c = c + 1
End If
Next
End Sub本回答被提问者采纳

Answer 5

写代码可以实现
序列 编号 明细
1 2406012820 5件20214535,12件20224598
2 2406013500 155件20273628,10件63503372
3 2406013390 1件21088403
4 2406029355 9件20217207