[已解决]求助为什么提取重复姓名和身份证两条代码没有重复时跳出应用程序定义或对象定义错

qinhuan66

求助各位老师为什么我的两条代码提取重复姓名和提取重复身份证号码的没有重复时跳出下图提示
如何改正 谢谢 。




提取重复姓名.rar (41.76 KB, 下载次数: 11)

2013-1-16 16:48 上传

点击文件名下载附件

代码如下：

Sub 提取重复身份证号()
Dim arr, brr(), crr(), d As Object
Set d = CreateObject("scripting.dictionary")
arr = Range("B3:B" & Range("B1000").End(xlUp).Row)
For i = 1 To UBound(arr)
    d(arr(i, 1)) = d(arr(i, 1)) + 1
Next i
For i = 1 To UBound(arr)
    arr(i, 1) = arr(i, 1) & d(arr(i, 1))
Next i
ReDim brr(1 To d.Count, 1 To 1)
ReDim crr(1 To d.Count, 1 To 1)
a = d.Keys: B = d.Items
For i = 0 To d.Count - 1
    If B(i) >= 2 Then
        s = s + 1
        brr(s, 1) = a(i)
        crr(s, 1) = B(i)
    End If
Next i
Sheets("考生资料分析").Range("D2").Resize(s, 1) = brr
Sheets("考生资料分析").Range("E2").Resize(s, 1) = crr

End Sub

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-1-16 17:01

提取重复姓名.rar (41.8 KB, 下载次数: 25)

2013-1-16 17:01 上传

点击文件名下载附件

跳转到最佳答案楼层

hwc2ycy

S是空值。

qinhuan66

hwc2ycy 发表于 2013-1-16 16:56
S是空值。

可以了谢谢提醒：谢谢
把这两个
Sheets("考生资料分析").Range("D2").Resize(s, 1) = brr
Sheets("考生资料分析").Range("E2").Resize(s, 1) = crr

换成下面这两个
Sheets("考生资料分析").Range("D2").Resize(1) = brr
Sheets("考生资料分析").Range("E2").Resize(1) = crr

hwc2ycy

把S定义加上去，再写入前加个判断S是否大于0，然后再写。
强制声明还是有好处的。

hwc2ycy

提取重复姓名.rar (41.8 KB, 下载次数: 25)

2013-1-16 17:01 上传

点击文件名下载附件

hwc2ycy

qinhuan66 发表于 2013-1-16 17:00
可以了谢谢提醒：谢谢
把这两个
Sheets("考生资料分析").Range("D2").Resize(s, 1) = brr

你这样换是头痛医痛脚痛医脚，等到有了重复的，代码又要出错了。

qinhuan66

hwc2ycy 发表于 2013-1-16 17:59
你这样换是头痛医痛脚痛医脚，等到有了重复的，代码又要出错了。

谢谢老师的指导

hwc2ycy

亲，最佳呢，我容易嘛，