[已解决]求单列重复与不重复值

fjmxwrs

回复 jiminyanyan 的帖子

2003的高级筛选没有提取不重复值这一项呀，后面的1就是指提取不重复。

etao06407

回复 jiminyanyan 的帖子

我希望可以通用，但老是出现提示错误，请帮忙解决这个问题，谢谢！

jiminyanyan

etao06407 发表于 2011-8-14 14:28
回复 jiminyanyan 的帖子

我希望可以通用，但老是出现提示错误，请帮忙解决这个问题，谢谢！

Sheet1.Activate改成
Sheet4.Activate
你附件里的表是Sheet4..

jiminyanyan

回复 fjmxwrs 的帖子

Sub Macro1()
'
' Macro1 Macro
    Range("A1:A34").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "I1"), Unique:=True
End Sub
Unique:=True 是提取非重复的，也就是上面代码的1.。

etao06407

回复 jiminyanyan 的帖子

我想得到的结果，是所有表中都可以运行，那怎么修改代码呢？请高手指点（注：不能只局限sheet1或者sheet4,所有的表都能通用）

etao06407

此方法可以运用所有表

1. Sub 求单列重复与不重复值ABC()
   
2.     Dim d As Object, i&, k&, m&, ar, arr(), arrr()
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     With Sheets("sheet1")
   
5.         .[c:e].ClearContents
   
6.         .[c1:e1] = Array("不重复值", "重复值", "重复次数")
   
7.         ar = .Range("a2", .[a65536].End(3))
   
8.         ReDim arr(1 To UBound(ar), 1 To 2)
   
9.         For i = 1 To UBound(ar)
   
10.             If Not d.Exists(ar(i, 1)) Then
    
11.                 k = k + 1
    
12.                 d(ar(i, 1)) = k
    
13.                 arr(k, 1) = ar(i, 1)
    
14.             End If
    
15.             arr(d(ar(i, 1)), 2) = arr(d(ar(i, 1)), 2) + 1
    
16.         Next
    
17.         ReDim arrr(1 To k, 1 To 3)
    
18.         For i = 1 To k
    
19.             If arr(i, 2) = 1 Then
    
20.                 j = j + 1
    
21.                 arrr(j, 1) = arr(i, 1)
    
22.             ElseIf arr(i, 2) > 1 Then
    
23.                 m = m + 1
    
24.                 arrr(m, 2) = arr(i, 1)
    
25.                 arrr(m, 3) = arr(i, 2)
    
26.             End If
    
27.         Next
    
28.         .[c2].Resize(k, 3) = arrr
    
29.     End With
    
30. End Sub

复制代码