根据数据A列去重，合并B列数据到同一个单元格

gwjkkkkk

参与一下。。。

Qs18

Sub qs()
Dim arr, i, dic
Set dic = CreateObject("scripting.dictionary")
arr = Sheet1.UsedRange.Value
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
For i = 2 To UBound(arr)
    t = arr(i, 1)
    If Not dic.exists(t) Then
        m = m + 1
        dic(t) = m
        brr(m, 1) = arr(i, 1)
        brr(m, 2) = arr(i, 2)
    Else
        r = dic(t)
        brr(r, 2) = brr(r, 2) & "," & arr(i, 2)
    End If
Next
Sheet2.Range("a2").Resize(m, UBound(brr, 2)) = brr
End Sub

Qs18

试试..........

Qs18

试试.......

zhangcheng6688

学习一下字典，打扰了
Sub test()
arr = Sheets("数据").[a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
ReDim brr(1 To UBound(arr), 1 To 2)
For i = 2 To UBound(arr)
   If Not d.exists(arr(i, 1)) Then
      m = m + 1
      brr(m, 1) = arr(i, 1)
      brr(m, 2) = arr(i, 2)
      d(arr(i, 1)) = m
   Else
      r = d(arr(i, 1))
      brr(r, 2) = brr(r, 2) & "," & arr(i, 2)
   End If
Next
Sheets("结果").[a1].CurrentRegion.Offset(1) = ""
Sheets("结果").[a2].Resize(m, 2) = brr
Set d = Nothing
End Sub

一招秒杀

首先通过 Unique 得到单位唯一列表， 再通过 TextJoin  得到各单位的订单列表，两个公式就完全搞定了，而且还是所见即所得，为什么你们喜欢编写那么多繁琐复杂冗长的代码，区区两个公式就瞬间秒杀它不香吗？我们不仅要解决问题，还要尽可能 低成本 高效地  准确 解决问题，最好未来的维护扩展还要简单。 那么多复杂冗长的代码，你可能看着香，别人使用 或者 后来人要  维护 扩展可能就要命了。

1. =TEXTJOIN(",",TRUE,FILTER($B$2:$B$17,$A$2:$A$17=D2))

复制代码

sdytsxd991122

wps练习一下

kyxfyzg

供参考。。。。。

今铭昔

烟火孤星泪

醉眼看尘世 发表于 2024-8-26 18:37

合并后的数据是否可以添加到批注上