自己编写的Find方法增强函数，可返回多个查找值

wbzxz · 发表于 2011-5-17 00:36

本帖最后由 wbzxz 于 2011-5-17 08:44 编辑

在初学VBA的时候，就感觉Range对象find方法很好用，尤其是找到某个值的时候，也不用循环（嘿嘿，因为我比较懒），但是find方法有个缺陷，一次只能找一个，比较郁闷，要多找几个的话，需要FindNext和FindPreviouse配合才行，所以每次碰到这个问题，总要写个循环，那时候就想着怎么样一次能找到全部符合条件的单元格呢，最近又碰到同样的问题，就通过翻阅资料，自己学着写了一个（其实网络上有人写的现成的），我也是自己学习，同时也愿意和大家分享。
我的这个函数的特点是，返回了一个collection对象，单元格都存在这个对象里面，可以通过索引值来引用，也容易循环，同时也可以删除添加，进行下一步处理。

我也只是初学，函数写的不对的地方，请大家指出来，我学习和修改，大家也可以试着用一用，嘿嘿。

'本函数是一个find方法的增强函数，结合FindNext和FindPrevious方法，可以返回一组符合条件的单元格的集合；
'本函数返回一个Collection对象，里面储存了找到的单元格；
'本函数有两个必选参数：
' 1.SearchRange 用来存放需要查找的区域；
' 2.FindWhat用来存放需要查找的值;
'其余参数都是可选参数，与Find方法参数相同；
'无论是否查找到单元格，都会返回一个collection对象；
'我们用Collection.Count=0，来判断，没有找到匹配的单元格；
Function FindPlus(SearchRange As Range, FindWhat As Variant, _
Optional After As Range, _
Optional LookIn As Variant = xlFormulas, _
Optional LookAt As Variant = xlPart, _
Optional SearchOrder As Variant = xlByRows, _
Optional SearchDirection As Variant = xlNext, _
Optional MatchCase As Variant = False, _
Optional MatchByte As Variant = True, _
Optional SearchFormat As Variant = False) As Collection
Dim FoundCell As Range '存放找到的单元格区域；
Dim AfterCell As Range '存放查找的起始单元格；
Dim FoundCol As Collection '存放找到单元格区域的集合；
Dim FirstAddress As String '存放第一次找到的单元格的地址
Set FoundCol = New Collection 'Collecion类实例化为对象
'下面这个判断语句完成对After参数值的控制
If After Is Nothing Then
Set AfterCell = SearchRange(SearchRange.Count) '如果after参数为空,则默认值为查找区域的最后一个单元格
Else
Set AfterCell = After '如果after参数不为空，这用提供的after参数值
End If
'查找第一个符合条件的值
Set FoundCell = SearchRange.Find(what:=FindWhat, After:=AfterCell, _
LookIn:=LookIn, _
LookAt:=LookAt, _
SearchOrder:=SearchOrder, _
SearchDirection:=SearchDirection, _
MatchCase:=MatchCase, _
MatchByte:=MatchByte, _
SearchFormat:=SearchFormat)
If Not FoundCell Is Nothing Then
FirstAddress = FoundCell.Address '如果找到第一个值，然后把单元格地址赋值给FirstAddress变量
'下面的循环是在区域里不断查找需要的值，并不断添加到FoundCol集合
Do
FoundCol.Add FoundCell '把找到的单元格赋值给FoundCol对象
'根据SearchDirection参数，判断是向上搜索，还是向下搜索
If SearchDirection = xlNext Then
Set FoundCell = SearchRange.FindNext(After:=FoundCell)
Else
Set FoundCell = SearchRange.FindPrevious(After:=FoundCell)
End If
Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddress) '经典用法，只要找到单元格和第一个找到的单元格地址不一样，就一直循环
End If
Set FindPlus = FoundCol '把集合对象赋值给函数名
End Function

复制代码

附件如下，大家请下载试用

FindPlus函数.rar (14.54 KB, 下载次数: 310)

bosao · 发表于 2014-2-11 00:08

谢谢分享

1071614166 · 发表于 2017-6-13 15:19

本帖最后由 1071614166 于 2017-6-13 15:22 编辑

求救！！怎么下载了附件运行显示下标越界？？？

qxkl0015 · 发表于 2020-6-15 08:30

这功能厉害。

是否可以查找多个不同数值呢?

dou10801 · 发表于 2020-6-15 16:20

好厲害,收下學習,感謝分享.

logo28 · 发表于 2021-11-11 22:37

好东东

AmoKat · 发表于 2021-11-11 23:01

Function FindPlus 可以當工作表函數使用嗎?

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

[分享] 自己编写的Find方法增强函数，可返回多个查找值