请老师模拟一下字典法得到上面的结果，谢谢！

hcy1185

数组字典法123.rar (7.89 KB, 下载次数: 27)

2024-7-29 11:07 上传

点击文件名下载附件

请老师模拟一下字典法得到上面的结果，谢谢！

杨建营

请楼主参考

杨建营

没有进行排序，没有嵌套，用了两个字典。

无关岁月

数组字典法123.7z (16.84 KB, 下载次数: 13)

2024-7-29 11:31 上传

点击文件名下载附件

杨建营

这个使用了字典嵌套。

半百

zhangcheng6688

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

hcy1185

杨建营 发表于 2024-7-29 11:30
请楼主参考

衷心感谢！下载学习。

Qs18

Sub qs()
Dim arr, i, dic
Set dic = CreateObject("scripting.dictionary")
With Sheet1
    arr = Sheet1.Range("a1").CurrentRegion.Value
    ReDim brr(1 To UBound(arr), 1 To 3)
For i = 2 To UBound(arr)
    s = arr(i, 2)
    If Not dic.exists(s) Then
        m = m + 1
        dic(s) = m
        For j = 2 To UBound(arr, 2)
            brr(m, j - 1) = arr(i, j)
        Next
    Else
        rw = dic(s)
        brr(rw, 2) = brr(rw, 2) & "," & arr(i, 3)
    End If
Next
.Range("h3").Resize(m, 3) = brr
End With
End Sub

Qs18

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