|
|
- Function Find_Range(Find_Item As Variant, _
- Search_Range As Range, _
- Optional LookIn As Variant, _
- Optional LookAt As Variant, _
- Optional MatchCase As Boolean) As Variant
- ' 定义一个名为Find_Range的函数，用于在指定的范围内查找指定项
- ' Find_Item: 要查找的项
- ' Search_Range: 要在其中进行查找的范围
- ' LookIn: 查找时要考虑的内容类型（可选，默认为xlValues）
- ' LookAt: 查找时要考虑的匹配类型（可选，默认为xlPart）
- ' MatchCase: 是否区分大小写（可选，默认为False）
-
- Dim c As Range
- Dim CustArry() As Variant
- Dim row As Integer
- Dim firstAddress As String
-
- If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
- If IsMissing(LookAt) Then LookAt = xlPart 'xlWhole
- If IsMissing(MatchCase) Then MatchCase = False
- ' 如果未提供LookIn、LookAt或MatchCase参数，则使用默认值
- Excel.Application.ScreenUpdating = False
- With Search_Range
- Set c = .Find( _
- What:=Find_Item, _
- LookIn:=LookIn, _
- LookAt:=LookAt, _
- SearchOrder:=xlByRows, _
- SearchDirection:=xlNext, _
- MatchCase:=MatchCase, _
- SearchFormat:=False)
- ' 在指定范围内查找指定项，并返回第一个匹配的单元格
- If Not c Is Nothing Then
- Set Find_Range = c
- firstAddress = c.Address
- Do
- Set Find_Range = Union(Find_Range, c)
- Set c = .FindNext(c)
- ' 将找到的单元格添加到Find_Range中，然后继续查找下一个匹配项
- Loop While Not c Is Nothing And c.Address <> firstAddress
- End If
- End With
- Excel.Application.ScreenUpdating = True
- End Function
- Sub TestFindRange()
- Dim resultRange As Range
- i0 = InputBox("请输入需要定位的值", "参数1")
- i1 = InputBox("请输入需要定位的范围", "参数2")
- Set resultRange = Find_Range(i0, Range(i1))
- If Not resultRange Is Nothing Then
- resultRange.Select
- Else
- MsgBox "未找到匹配项"
- End If
- End Sub
|
评分
-
1
查看全部评分
-
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-3-2 20:48
楼主