[已解决]高手给看一看 宏有什么错误呀!

dong66094799

回复 lisachen 的帖子

Sub 高级筛选1()

    With Sheets("Sheet1")

        Dim arr, n As Double, dic As New Dictionary, brr()

        n = .Range("a65536").End(xlUp).Row

        arr = .Range("a1:b" & n)

        For i = 1 To UBound(arr)

            If dic.Exists(arr(i, 2)) Then

                m = m + 1

                ReDim Preserve brr(1 To 2, 1 To m)

                brr(1, m) = arr(i, 1): brr(2, m) = arr(i, 2)

            Else

                dic(arr(i, 2)) = arr(i, 1)

            End If

        Next

        .Range("e:f").ClearContents

        .Range("e1:f1") = Array("姓名", "身份证号")

        .Range("e2").Resize(m, 2) = Application.Transpose(brr) 'E、F列放身份证号有重复的

        .Range("c:d").ClearContents

        .Range("c1").Resize(dic.Count) = Application.Transpose(dic.Items) 'C列、D列放不重复值

        .Range("d1").Resize(dic.Count) = Application.Transpose(dic.Keys)

    End With

End Sub

我代码复制宏内了 还不好使呀?

放浪形骸

你的出错的原因在于如果没有出现相同的身份证号的话，那就会使得brr为空，那么出错的那句就不能调用了。

放浪形骸

那现在给你加一条语句就可以了：

1. Sub 高级筛选1()
   
2.     With Sheets("Sheet1")
   
3.         Dim arr, n As Double, dic As New Dictionary, brr()
   
4.         n = .Range("a65536").End(xlUp).Row
   
5.         arr = .Range("a1:b" & n)
   
6.         For i = 1 To UBound(arr)
   
7.             If dic.Exists(arr(i, 2)) Then
   
8.                 m = m + 1
   
9.                 ReDim Preserve brr(1 To 2, 1 To m)
   
10.                 brr(1, m) = arr(i, 1): brr(2, m) = arr(i, 2)
    
11.             Else
    
12.                 dic(arr(i, 2)) = arr(i, 1)
    
13.             End If
    
14.         Next
    
15.         .Range("e:f").ClearContents
    
16.         .Range("e1:f1") = Array("姓名", "身份证号")
    
17.         On Error Resume Next
    
18.         .Range("e2").Resize(m, 2) = Application.Transpose(brr) 'E、F列放身份证号有重复的
    
19.         .Range("c:d").ClearContents
    
20.         .Range("c1").Resize(dic.Count) = Application.Transpose(dic.Items) 'C列、D列放不重复值
    
21.         .Range("d1").Resize(dic.Count) = Application.Transpose(dic.Keys)
    
22.     End With
    
23. End Sub

复制代码

On Error Resume Next
出错了之后继续接下来的程序，就OK了。
你试下

放浪形骸

dong66094799 发表于 2011-8-18 22:52
回复 lisachen 的帖子

Sub 高级筛选1()

你不好试的原因是在于你的数据里是没有存在重复的数据，所以就会使得brr未定义，那么就会在出错的语句中无法调用。

dong66094799

回复 放浪形骸 的帖子

非常感谢 {:021:}

放浪形骸

dong66094799 发表于 2011-8-18 22:42
我想做到 A B列有数据时筛选,并在E F列显示出所有A B列重复数据而不是只显示一个重复数据
例如AB列 张三 3 ...

而提取出重复的数据的时候，用了

1. brr(1, m) = dic(arr(i, 2))

复制代码

这里是把首先放到字典里的重复的身份证号对应的第一个名字给显示出来，所以在我最早给的示例里的话，后面重复的地方会显示出与不重复的名字一样的内容。
改成

1. brr(1, m) = arr(i, 1)

复制代码

就将重复身份证的不同名字给保存进去了。