一个场地会对应多个车牌号去重复后排列下来如何实现

lujun0323

A列是“场地”，B列是“车牌号”，我想得到一个场地对应了多少个不重复的车牌号。请大神帮忙？附件里面有说明。
实例.rar (7.64 KB, 下载次数: 16)

2019-6-14 12:45 上传

点击文件名下载附件

xiangbaoan

Sub test()
Dim ar, d As Object, i&, k, s$, t$, m&, n&
ar = Range("a2:b" & Cells(Rows.Count, 1).End(xlUp).Row)
ReDim br(1 To UBound(ar), 1 To 2)
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(ar)
    s = ar(i, 1)
    t = ar(i, 2)
    If Not d.exists(s) Then Set d(s) = CreateObject("scripting.dictionary")
    d(s)(t) = ""
Next
For Each k In d.keys
    m = 0
    For i = 0 To d(k).Count - 1
        m = m + 1
        n = n + 1
        If m = 1 Then br(n, 1) = k
        br(n, 2) = d(k).keys()(i)
    Next
Next
With [e1]
    .Resize(Rows.Count, 2).ClearContents
    .Resize(1, 2) = [{"场地","车牌号"}]
    .Offset(1).Resize(n, 2) = br
End With
Set d = Nothing
End Sub

lujun0323

多谢大神解决了我的问题，这个数组加字典我好好研究一下。

liuxi001

写了也贴一下

1. Sub lx()
   
2.     ar = [a1].CurrentRegion
   
3.     ReDim cr(1 To UBound(ar) - 1, 1 To UBound(ar, 2))
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     For i = 2 To UBound(ar)
   
6.         s = Trim(ar(i, 1))
   
7.         ss = Trim(ar(i, 2))
   
8.         If Not d.exists(s) Then Set d(s) = CreateObject("scripting.dictionary")
   
9.         d(s)(ss) = ""
   
10.     Next
    
11.     dd = d.keys
    
12.     For n = 0 To UBound(dd)
    
13.         For c = 0 To d(dd(n)).Count - 1
    
14.             k = k + 1
    
15.             If c = 0 Then cr(k, 1) = dd(n)
    
16.             cr(k, 2) = d(dd(n)).keys()(c)
    
17.         Next
    
18.     Next
    
19.     [h2].Resize(k, 2) = cr
    
20. End Sub

复制代码

lujun0323

多谢热心的朋友

lujun0323

多谢各位热心的朋友了。