[已解决]关于筛选，如果筛选特定条件的结果没有时报错

mooming · 发表于 2015-3-5 22:19

如下代码，要找出区域内出现5次的值，并逐一显示在F列中，当有结果时显示出了正确的结果

但是如果没有结果的话，就报错了

请问该如何修改一下代码当没有符合条件的结果时就显示无或者空值呢？谢谢！

Sub scan()
Dim d, k, t, arr, cel, r&, arr1()
Set d = CreateObject("Scripting.Dictionary")
arr = [n1:bo10000]
For Each cel In arr
      If cel <> "" Then
         d(cel) = d(cel) + 1
      End If
Next
k = d.Keys
t = d.items
ReDim arr1(1 To UBound(k) + 1, 1 To 1)
For i = 0 To UBound(k)
If t(i) >= 5 Then
      r = r + 1
      arr1(r, 1) = k(i)
End If
Next
[f1].Resize(r) = arr1
End Sub

最佳答案

月排行榜 / 总排行榜

dsmch

2015-3-6 05:07

Sub scan()
Dim d, arr, cel, r&, arr1()
Set d = CreateObject("Scripting.Dictionary")
[f:f] = ""
arr = [n1:bo10000]
ReDim arr1(1 To 60000, 1 To 1)
For Each cel In arr
If cel <> "" Then
d(cel) = d(cel) + 1
If d(cel) = 5 Then
r = r + 1
arr1(r, 1) = cel
If r > UBound(arr1) - 1 Then Exit For
End If
End If
Next
If r < 1 Then
Exit Sub
ElseIf r = 1 Then [f1] = arr1(1, 1)
Else
[f1].Resize(r) = arr1
End If
End Sub

复制代码

跳转到最佳答案楼层

mooming · 发表于 2015-3-5 22:20

今天学雷锋活动日哈哈
坛子里肯定还有好多雷锋没休息

mooming · 发表于 2015-3-5 22:30

元宵+雷锋呵呵继续期待

mooming · 发表于 2015-3-5 22:40

再等等，希望有高手出手！

mooming · 发表于 2015-3-5 23:10

Next
If r > 0 Then [f1].Resize(r) = arr1 Else [f1] = ""
End Sub

dsmch · 发表于 2015-3-6 05:07

Sub scan()
Dim d, arr, cel, r&, arr1()
Set d = CreateObject("Scripting.Dictionary")
[f:f] = ""
arr = [n1:bo10000]
ReDim arr1(1 To 60000, 1 To 1)
For Each cel In arr
If cel <> "" Then
d(cel) = d(cel) + 1
If d(cel) = 5 Then
r = r + 1
arr1(r, 1) = cel
If r > UBound(arr1) - 1 Then Exit For
End If
End If
Next
If r < 1 Then
Exit Sub
ElseIf r = 1 Then [f1] = arr1(1, 1)
Else
[f1].Resize(r) = arr1
End If
End Sub

复制代码

		自动登录	找回密码
密码			注册

[已解决]关于筛选，如果筛选特定条件的结果没有时报错

相关帖子