关于字典或数组，唯一，重复，去重的取值问题

ericniming

yech20 发表于 2018-12-18 21:19
话说计数判断怎么写呢？
if d.item =>2 then还是if d.item 2 then还是if d.items

后面方法就很多了，比如按照你想的方法：n=1
for i=1 to d.count
if d(arr(i,1)) =>2 then
cells(n,"C")=arr(i,1) 直接往单元格里写满足条件的key呗
n=n+1
end if
next

yech20

ericniming 发表于 2018-12-18 21:46
后面方法就很多了，比如按照你想的方法：n=1
for i=1 to d.count
if d(arr(i,1)) =>2 then

d.count?
这是key的计数吧

micch

test.zip (14.67 KB, 下载次数: 37)

2018-12-18 22:24 上传

点击文件名下载附件

正好这些天在学字典，本想在加字典的同时完成分列，但是只能把重复的同时带出来，去重复的不行，只好还是分步完成了

1. Sub tt()
   
2.    
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = [a1:a26]
   
5.     For i = 1 To 26: d(arr(i, 1)) = 1 + d(arr(i, 1)): Next
   
6.     br = d.keys: n = d.Count
   
7.     ReDim cr(0 To n): ReDim dr(0 To n)
   
8.     For i = 0 To n - 1
   
9.         If d.Item(br(i)) = 1 Then
   
10.             dr(j) = br(i): j = j + 1
    
11.         Else
    
12.             cr(k) = br(i): k = k + 1
    
13.         End If
    
14.     Next
    
15.         
    
16.     [b1].Resize(n) = Application.Transpose(br)
    
17.     [c1].Resize(k) = Application.Transpose(cr)
    
18.     [d1].Resize(j) = Application.Transpose(dr)
    
19.    
    
20. End Sub
    
21. 
    
22. 
    

复制代码

cjc209

这种要调用工作表countif就好整

yech20

micch 发表于 2018-12-18 22:25
正好这些天在学字典，本想在加字典的同时完成分列，但是只能把重复的同时带出来，去重复的不行，只好还是 ...

厉害了，我的哥~
看了这么多教程，我还在沉迷于exists,remove如何使用能看懂不概，要是能备注下，讲解下思路就更好了

liulang0808

http://club.excelhome.net/thread-1385473-1-1.html
一些字典的案例，可以参考下的

micch

换个思路，一次字典

1. Sub tt()
   
2. 
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = [a1:a26]
   
5.     For i = 1 To 26
   
6.     If d.exists(arr(i, 1)) Then
   
7.         d(arr(i, 1)) = arr(i, 1) & 3
   
8.     Else
   
9.         d(arr(i, 1)) = arr(i, 1) & 4
   
10.     End If
    
11.     Next
    
12.     br = d.keys
    
13.     cr = Filter(d.items, 3)
    
14.     dr = Filter(d.items, 4)
    
15.         
    
16.     [b1].Resize(d.Count) = Application.Transpose(br)
    
17.     [c1].Resize(UBound(cr) + 1) = Application.Transpose(cr)
    
18.     [d1].Resize(UBound(dr) + 1) = Application.Transpose(dr)
    
19.     [c1:c26].Replace What:="3", Replacement:=""
    
20.     [d1:d26].Replace What:="4", Replacement:=""
    
21.    
    
22. End Sub
    
23. 
    

复制代码

MOY838840554

参考
VBA用字典去重A列只出现一次
http://club.excelhome.net/thread-1451175-1-1.html
(出处: ExcelHome技术论坛)

micch

yech20 发表于 2018-12-18 22:52
厉害了，我的哥~
看了这么多教程，我还在沉迷于exists,remove如何使用能看懂不概，要是能备注下，讲解下 ...

这也没啥思路，就是把数据源做个循环加字典，自动就去重了。b列就是keys
根据item的数量，用一个循环把值是1的分到d列，值不是1也就是有重复的分到c列。

第二种方法就是加字典的同时，把有重复的和无重复的用exist判断，并且在item里做好标记；
然后用filter筛选items就分别得到cd列的内容。
最后用replace把标记替换掉

一把小刀闯天下

Option Explicit

  Sub test()
    Dim arr, i, j, t
    arr = Range("a1:a" & Cells(Rows.Count, "a").End(xlUp).Row + 1)
    ReDim brr(1 To UBound(arr, 1), 1 To 3), n(1 To UBound(brr, 2))
    For i = 1 To UBound(arr, 1) - 2
      For j = i + 1 To UBound(arr, 1) - 1
        If arr(i, 1) > arr(j, 1) Then
          t = arr(i, 1): arr(i, 1) = arr(j, 1) = arr(j, 1) = t
        End If
    Next j, i
    For i = 1 To UBound(arr, 1) - 1
      For j = i To UBound(arr, 1) - 1
        If arr(j, 1) <> arr(j + 1, 1) Then
          n(1) = n(1) + 1: brr(n(1), 1) = arr(i, 1) '唯一
          If j > i Then n(2) = n(2) + 1: brr(n(2), 2) = arr(i, 1) '重复
          If j = i Then n(3) = n(3) + 1: brr(n(3), 3) = arr(i, 1) '去重
          i = j: Exit For
        End If
    Next j, i
    For i = 2 To UBound(n)
      If n(1) < n(i) Then n(1) = n(i)
    Next
    [b1].Resize(n(1), UBound(brr, 2)) = brr
  End Sub