怎样自动删除一列数据的重复值并自动排序

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr()
   
4.     Dim sl As Object
   
5.     Set sl = CreateObject("system.collections.sortedlist")
   
6.     With Worksheets("sheet1")
   
7.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.         arr = .Range("a2:a" & r)
   
9.         For i = 1 To UBound(arr)
   
10.             If sl.contains(arr(i, 1)) = False Then
    
11.                 sl.Add arr(i, 1), Empty
    
12.             End If
    
13.         Next
    
14.         ReDim brr(1 To sl.keys.Count, 1 To 1)
    
15.         For i = 0 To sl.keys.Count - 1
    
16.             brr(i + 1, 1) = sl.getkey(i)
    
17.         Next
    
18.         .Range("f2").Resize(UBound(brr), 1) = brr
    
19.     End With
    
20. End Sub
    

复制代码

chxw68

纯属练手。

cdga110

@tspliu 稍微动作多一点的操作，录制的宏有大量无用代码，基础差一些的无法甄别，但最重要的是基本没有通用和可移植性，体验感不好；

@无敌小猪猪 代码是原列操作，方法可行，完全可以借鉴，但这个是静态化的，更多的应用场景是原数据列是一直有变化且不能直接操作，所以需要在另处某列进行动态的同步去重排序操作；

@lihaosh  关于变量名长度的问题，首先你的操作是规范的，就如你说的，原则上变量名长一点确实不是问题，这是一种良好的编程习惯，就像代码缩进和代码注释一样，完全有利编程写作，我完全认可，真心向你学习，但我也同意@zxsea_7426 、@ykcbf1100 提出的看法，本人提出的这个纯粹就某一知识点的方法学习，简洁一点也明了易读易体会，反正在变量名的长短与否，其实都没有任何问题，一个看各人习惯。一个是看代码体量，灵活运用就行，这个不是根本问题；
    但我没有搞清楚，你的两个方法第1 次运行没有问题，但第二次和多次的运行后总是有点小问题，等我再仔细的看一下我的运行环境哪个地方不对，高版本的那两行代码也收下了，等哪天用得上的时候再学习；

@zxsea_7426  你一下给出三个方法，让这个看似简单的问题又打开了不一样的角度，我一定慢慢去体会学习！

@chxw68  谢谢，这个确实就是用一个典型的常用操作的来练手学习的。

最后，我自己也解决了在另处某列进行操作的问题，也有两个方法，写在后面，个人觉得第二个方案最简单粗暴，就是复制粘贴然后排序去重，貌似适用于所有单列源数据的情况，请以上朋友指正！

所有回复的朋友都会评分，今天的额度已用完，周一周二会补齐的。

最后，我把大家的代码按顺序一字不改全部写在这个练习表中，对于发图片的朋友尊重你们的意思，不录代码只作提示，作为这个典型应用的多方法解决标准，成为可借鉴模板，希望共同学习，一起进步！

最后，再次谢谢大家的无私支持！



Sub testA()
    Dim d As Object
    Dim arr, i%
    Set d = CreateObject("scripting.dictionary")
    arr = Range("a2:a" & Sheet1.Cells(Rows.Count, 1).End(3).Row)
        For i = 1 To UBound(arr)
            If Not d.exists(arr(i, 1)) Then
                d(arr(i, 1)) = ""
            End If
        Next
    Columns("C:C").ClearContents
    Range("C2").Resize(d.Count, 1) = Application.Transpose(d.keys)
    Set d = Nothing
End Sub



Sub testB()
    Range("A2", Cells(Rows.Count, 1).End(xlUp)).Copy [C1]
    Range("C:C").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

zxsea_7426

cdga110 发表于 2023-4-14 12:17
@tspliu 稍微动作多一点的操作，录制的宏有大量无用代码，基础差一些的无法甄别，但最重要的是基本没有通用 ...

没有看你附件。但你文字代码第二段，只去重了，缺少排序