[已解决]出现“类型不匹配”的问题如何解决

KDZ

出现“类型不匹配”的问题，因为行太多了，总不能一行一行地找啊，请指教如何一次性解决，谢谢！
现将电子表 及 代码 附件呈上。

最佳答案

月排行榜 / 总排行榜

那么的帅

2014-3-11 16:20

KDZ 发表于 2014-3-11 16:03
你好，谢谢你！不过运行后又出现“溢出的问题”，请您再看一看，谢谢！

1. Sub 删除重复行()
   
2.     Dim d, rng As Range, i&, p$, j%
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     With Sheets("sheet2")
   
5.         row1 = .Range("E" & .Rows.Count).End(xlUp).Row
   
6.         arr = .Range("Q4:AE" & row1)
   
7.         arr1 = .Range("A4:H" & row1)
   
8.     End With
   
9. 
   
10.     For i = 1 To UBound(arr)
    
11.         p = ""
    
12.         For j = 1 To UBound(arr, 2)
    
13.             p = p & "," & IIf(IsError(arr(i, j)), 0, arr(i, j))
    
14.         Next
    
15.         If Not d.exists(p) Then
    
16.             d(p) = ""
    
17.         Else
    
18.             If rng Is Nothing Then Set rng = Cells(i, 1) Else Set rng = Union(rng, Cells(i, 1))
    
19.         End If
    
20.     Next
    
21.     '前几列名称重复且22、29列为空，挑选17-19三列含1靠前的行
    
22.     For j = 3 To 1 Step -1
    
23.         For i = 1 To UBound(arr)
    
24.             If arr(i, 6) = "" And arr(i, 13) = "" And IIf(IsError(arr(i, j)), 0, arr(i, j)) = 1 Then
    
25.                 p = arr1(i, 1) & "," & arr1(i, 2) & "," & arr1(i, 5) & "," & arr1(i, 8)
    
26.                 If Not d.exists(p) Then
    
27.                     d(p) = i
    
28.                 Else
    
29.                     If rng Is Nothing Then Set rng = Cells(i, 1) Else Set rng = Union(rng, Cells(i, 1))
    
30.                     d(p) = i
    
31.                 End If
    
32.             End If
    
33.         Next
    
34.     Next
    
35.     If Not rng Is Nothing Then rng.EntireRow.Delete
    
36. End Sub

复制代码

跳转到最佳答案楼层

xdragon

因为里面有错误值，加个判断语句就可以解决了

1. Sub 删除重复行()
   
2. Dim arr, d, rng As Range, i&, p$, j%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = ActiveSheet.UsedRange
   
5.                                                       
   
6. For i = 4 To UBound(arr)
   
7.     p = ""
   
8.     For j = 1 To UBound(arr, 2)
   
9.         p = p & "," & IIf(IsError(arr(i, j)), 0, arr(i, j))
   
10.     Next
    
11.     If Not d.exists(p) Then
    
12.         d(p) = ""
    
13.     Else
    
14.         If rng Is Nothing Then Set rng = Cells(i, 1) Else Set rng = Union(rng, Cells(i, 1))
    
15.     End If
    
16. Next
    
17. '前几列名称重复且22、29列为空，挑选17-19三列含1靠前的行
    
18. For j = 19 To 17 Step -1
    
19.     For i = 4 To UBound(arr)
    
20.         If arr(i, 22) = "" And arr(i, 29) = "" And IIf(IsError(arr(i, j)), 0, arr(i, j)) = 1 Then
    
21.             p = arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 5) & "," & arr(i, 8)
    
22.             If Not d.exists(p) Then
    
23.                 d(p) = i
    
24.             Else
    
25.                 If rng Is Nothing Then Set rng = Cells(i, 1) Else Set rng = Union(rng, Cells(i, 1))
    
26.                 d(p) = i
    
27.             End If
    
28.         End If
    
29.     Next
    
30. Next
    
31. If Not rng Is Nothing Then rng.EntireRow.Delete
    
32. 
    
33. End Sub

复制代码

KDZ

xdragon 发表于 2014-3-11 15:28
因为里面有错误值，加个判断语句就可以解决了

你好，谢谢你！不过运行后又出现“溢出的问题”，请您再看一看，谢谢！

那么的帅

KDZ 发表于 2014-3-11 16:03
你好，谢谢你！不过运行后又出现“溢出的问题”，请您再看一看，谢谢！

1. Sub 删除重复行()
   
2.     Dim d, rng As Range, i&, p$, j%
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     With Sheets("sheet2")
   
5.         row1 = .Range("E" & .Rows.Count).End(xlUp).Row
   
6.         arr = .Range("Q4:AE" & row1)
   
7.         arr1 = .Range("A4:H" & row1)
   
8.     End With
   
9. 
   
10.     For i = 1 To UBound(arr)
    
11.         p = ""
    
12.         For j = 1 To UBound(arr, 2)
    
13.             p = p & "," & IIf(IsError(arr(i, j)), 0, arr(i, j))
    
14.         Next
    
15.         If Not d.exists(p) Then
    
16.             d(p) = ""
    
17.         Else
    
18.             If rng Is Nothing Then Set rng = Cells(i, 1) Else Set rng = Union(rng, Cells(i, 1))
    
19.         End If
    
20.     Next
    
21.     '前几列名称重复且22、29列为空，挑选17-19三列含1靠前的行
    
22.     For j = 3 To 1 Step -1
    
23.         For i = 1 To UBound(arr)
    
24.             If arr(i, 6) = "" And arr(i, 13) = "" And IIf(IsError(arr(i, j)), 0, arr(i, j)) = 1 Then
    
25.                 p = arr1(i, 1) & "," & arr1(i, 2) & "," & arr1(i, 5) & "," & arr1(i, 8)
    
26.                 If Not d.exists(p) Then
    
27.                     d(p) = i
    
28.                 Else
    
29.                     If rng Is Nothing Then Set rng = Cells(i, 1) Else Set rng = Union(rng, Cells(i, 1))
    
30.                     d(p) = i
    
31.                 End If
    
32.             End If
    
33.         Next
    
34.     Next
    
35.     If Not rng Is Nothing Then rng.EntireRow.Delete
    
36. End Sub

复制代码

xdragon

KDZ 发表于 2014-3-11 16:03
你好，谢谢你！不过运行后又出现“溢出的问题”，请您再看一看，谢谢！

你好，看楼上的回复吧。溢出是因为你的usedrange区域过大，导致内存不够。
分开需要处理的区域放入数组运算就能解决了。

KDZ

谢谢各位的热心，解决“类型不配”的代码管用，解决“溢出”的代码可能与我的原表不一致吧，放在我的原表不可用，现将基本上原表呈上，请各位高手指教，谢谢！

KDZ

1表.zip (354.91 KB, 下载次数: 7)

2014-3-12 12:09 上传

点击文件名下载附件

那么的帅 发表于 2014-3-11 16:20

你好，谢谢，我将你的代码按我的条件小加变动放在我的原表中，又出现下标越界，现将原表呈上，请帮忙修改一下，谢谢！！

原表太大上传不了，只能上传一部分，不知又会不会出什么问题


不好意思，附件太大未能上传成功，重新上传，请重新下载。

KDZ

不好意思，附件太大未能上传成功，重新上传，请重新下载。