数组去重复

爱疯

1. Sub test2_2()
   
2.     Dim A, B, i
   
3.     A = [a1:a10]
   
4.     '确保数组A的元素值在B的索引范围内，即在B中能找到对应位置。
   
5.     If Application.Min(A) > LBound(A) Then End
   
6.     If Application.Max(A) > UBound(A) Then End
   
7.     ReDim B(UBound(A) - 1)    '存放A()的索引号
   
8.     For i = 1 To UBound(A)
   
9.         B(A(i, 1)) = A(i, 1)    '情况1：去重复排序
   
10. '        B(A(i, 1)) = B(A(i, 1)) & " " & A(i, 1)    '情况2：含重复排序
    
11.     Next i
    
12.     B = Split(Application.Trim(Join(B)))
    
13.     Columns(2).ClearContents
    
14.     [b1].Resize(UBound(B) + 1) = Application.Transpose(B)
    
15. End Sub

复制代码

原帖：http://www.excelpx.com/thread-254911-1-1.html
这是学习 wcymiss的方法。
如果A1:A10的值范围是0~9，就可去重复；
如果A1:A10的值范围不是0~9，比如A10改为15，就会出错。



问题：如何修改，比如在A10改为15后，还可去重复？
谢谢！

djyjysxxs

对数字有效，且都有弱点
Sub test1()
    Dim A, B, i, r
    A = [a1:a10]
    ReDim B(Application.Min(A) To Application.Max(A), 1 To 1)
    For i = 1 To UBound(A)
        B(A(i, 1), 1) = A(i, 1)
    Next i
    For i = LBound(B) To UBound(B)
        If B(i, 1) Then
           r = r + 1
           A(r, 1) = B(i, 1)
        End If
    Next
    [d1].Resize(r) = A
End Sub
Sub test2()
    Dim A, B, i, r, s
    A = [a1:a10]
    ReDim B(Application.Min(A) To Application.Max(A), 1 To 1) As Boolean
    For i = 1 To UBound(A)
        If Not B(A(i, 1), 1) Then
           B(A(i, 1), 1) = 1
           s = s & "," & A(i, 1)
           r = r + 1
        End If
    Next i
    If Len(s) Then
       s = Mid(s, 2)
      [c1].Resize(r) = Application.Transpose(Split(s, ","))
    End If
End Sub
etc.

爱疯

djyjysxxs 发表于 2013-4-4 22:35
对数字有效，且都有弱点
Sub test1()
    Dim A, B, i, r

谢谢天堂鼠，学习了！


ReDim B(Application.Min(A) To Application.Max(A))

你的test1确实比1楼加强了适用性
但test2比test1，多了判断以及&运算，算是不好的一面吧。test2有比test1好的地方么？

djyjysxxs

爱疯 发表于 2013-4-4 23:26
谢谢天堂鼠，学习了！

同是10个数，只是把其中个别数改得很大，然后再试试看

爱疯

djyjysxxs 发表于 2013-4-4 23:36
同是10个数，只是把其中个别数改得很大，然后再试试看

如果数组A的元素最大值，大于32756就会报错：

运行时错误'1004
应用程序定义或对象定义错误

32756（或65512）是个什么极限？

无聊的疯子

对于去重复,可以直接使用高级筛选
代码简单,至于效率嘛,数据量大的时候肯定比用数组加字典要慢点!!

1. 
   
2. Sub test2_2()
   
3.   Range("B:B").ClearContents
   
4.   Range("A:A").AdvancedFilter 2, Range("C1:C2"), Range("B1"), True
   
5.   Range("B:B").Sort Range("B1"), 1
   
6. End Sub
   

复制代码

无聊的疯子

出错的情况还没有测试出来,前面有代码判断,范围超出了 ubound 就会结束运行

对于数字去重复并排序,可以这样修改,不受限止正负数限止,只是上下限有数据范围要求

1. 
   
2. Sub test2_2()
   
3.     Dim A, B, i
   
4.    
   
5.     A = [a1:a10]
   
6.     ReDim B(Application.Min(A) To Application.Max(A))  '存放A()的索引号
   
7.     For i = 1 To UBound(A)
   
8.         B(A(i, 1)) = A(i, 1)    '情况1：去重复排序
   
9.     Next i
   
10.     B = Split(Application.Trim(Join(B)))
    
11.     Columns(2).ClearContents
    
12.     [b1].Resize(UBound(B) + 1) = Application.Transpose(B)
    
13.    
    
14. End Sub
    

复制代码

无聊的疯子

爱疯 发表于 2013-4-5 00:01
如果数组A的元素最大值，大于32756就会报错：

运行时错误'1004

受 Trim 所能接收的字符长度限制

把代码拆分出来进行测试
Sr = Join(B, ",")
B = Split(Application.Trim(Sr))

会有同样的错误提示,那就是受 trim 限止了


帮助中

Excel 开发人员参考

支持长字符串的工作表函数列表

下表说明了所有支持长度大于 255 个字符的字符串的工作表函数。这些函数的最大字符串长度为 32767。有关特定函数的详细信息，请参阅 Office 网站上的函数参考主题。

但是没有明确说明 trim 的字符长度是多少

爱疯

无聊的疯子 发表于 2013-4-5 07:38
受 Trim 所能接收的字符长度限制

把代码拆分出来进行测试

前面5楼我说错了，应该是：
如果数组B定义的容量<=32756，那么可以Application.Trim() ；
否则，不可以Application.Trim()。

奇怪的是，为什么是32756这样一个常数？
PS：动画里E3里也是“数组B定义的数组”

leolee82

用排序算法，得到一个排序后的索引数组ar，再循环arr(ar(i))去重复