不用字典编程去除单列中重复的数据保留唯一值

吴中泉

今天讨论编程去除单列中重复的数据,保留唯一值,当然用字典实现简单速度快,用菜单命令删除重复项更简单易得.

发这个帖子,主要讨论VBA编程基础知识,看看有没有更好的算法实现.感兴趣的请顶一下.



我先发两段程序,已经测试,正常运行.代码如下:

1. 
   
2. '利用一个数组时间复杂度高,慢
   
3. Sub 去除单列中重复项1()
   
4.     Dim arr
   
5.     Dim i, j, m, max_row As Long
   
6.     t = Timer
   
7.     max_row = Range("a1008888").End(xlUp).Row - 1
   
8.     arr = WorksheetFunction.Transpose([a2].Resize(max_row, 1))
   
9.       
   
10.    '查找去除单列中重复值
    
11.     For i = 1 To max_row
    
12.         If arr(i) = Chr(0) Then Exit For
    
13.         For j = max_row To i + 1 Step -1
    
14.             If arr(i) = arr(j) Then
    
15.                 m = j
    
16.                 Do While m < max_row
    
17.                     arr(m) = arr(m + 1): m = m + 1
    
18.                 Loop
    
19.                 arr(m) = Chr(0) '清空并设置标志
    
20.             End If
    
21.         Next j
    
22.     Next i
    
23.    
    
24.     Range("c2:c" & max_row).Clear
    
25.     Range("c2").Resize(max_row, 1) = WorksheetFunction.Transpose(arr)
    
26.     Erase arr
    
27. 
    
28.     MsgBox Timer - t
    
29. 
    
30. End Sub
    
31. 
    
32. 
    
33. 
    
34. '利用临时数组中转,空间复杂度高,较快
    
35. 
    
36. Sub 去除单列中重复项2()
    
37.     Dim arr, arr_temp()
    
38.     Dim i, j, m, g, max_row As Long
    
39.     t = Timer
    
40.     max_row = Range("a1008888").End(xlUp).Row - 1
    
41.     arr = WorksheetFunction.Transpose([a2].Resize(max_row, 1))
    
42.       
    
43.    '查找单列中重复值并清空
    
44.     For i = 1 To max_row
    
45.         For j = i + 1 To max_row
    
46.             If arr(i) = arr(j) Then
    
47.                 arr(j) = Chr(0)
    
48.             End If
    
49.         Next j
    
50.     Next i
    
51.    
    
52.     '将不重复值放入临时数组
    
53.     For i = 1 To max_row
    
54.         If arr(i) <> Chr(0) Then
    
55.             g = g + 1
    
56.             ReDim Preserve arr_temp(1 To g)
    
57.             arr_temp(g) = arr(i)
    
58.         End If
    
59.     Next i
    
60.    
    
61.     Range("e2:e" & max_row).Clear
    
62.     Range("e2").Resize(g, 1) = WorksheetFunction.Transpose(arr_temp)
    
63.     Erase arr, arr_temp
    
64.    
    
65.     MsgBox Timer - t
    
66. 
    
67. End Sub
    
68. 
    

复制代码

吴中泉

实际测试5000行单列有重复数据,两段程序都在1秒左右,差不多.

吴中泉

1. '利用一个自定义集合时间复杂度低,非常快，和用字典相当
   
2. Sub 去除单列中重复项()
   
3.     Dim arr, brr, nums As New Collection
   
4.     Dim i, max_row As Long
   
5.     't = Timer
   
6.     max_row = Range("a1008888").End(xlUp).Row - 1
   
7.     arr = [a2].Resize(max_row, 1)
   
8.       
   
9.    '用自定义集合去除单列中重复值
   
10.     On Error Resume Next
    
11.     For i = 1 To max_row
    
12.         nums.Add arr(i, 1), CStr(arr(i, 1))
    
13.     Next i
    
14.    
    
15.     '写入J列
    
16.     Range("j2:j" & max_row).Clear
    
17.     ReDim brr(1 To nums.Count)
    
18.     i = 1
    
19.     For Each Item In nums
    
20.         brr(i) = Item: i = i + 1
    
21.     Next
    
22.     Range("j2").Resize(nums.Count, 1) = _
    
23.         WorksheetFunction.Transpose(brr)
    
24.     Erase arr
    
25.     Set nums = Nothing
    
26. 
    
27.     'MsgBox Timer - t
    
28. 
    
29. End Sub
    
30. 
    
31. 
    
32. 
    

复制代码

吴中泉

用自定义集合只是一个思路，实际用到这里不如字典方便，虽然速度差不多。

lizhipei78

RemoveDuplicates
系统自带的函数不用，搞那么复杂

吴中泉

lizhipei78 发表于 2023-4-25 16:38
RemoveDuplicates
系统自带的函数不用，搞那么复杂

还没有了解到啊

你地铁图

find 也行。。。。。