一个FindAll函数，谁有时间看看写得怎么样？

liucqa · 发表于 2012-3-20 13:35

本帖最后由 liucqa 于 2013-9-23 10:12 编辑

Function FindAll(SearchRange As Range, _
FindWhat As Variant, _
Optional LookIn As XlFindLookIn = xlValues, _
Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional MatchCase As Boolean = False, _
Optional BeginsWith As String = vbNullString, _
Optional EndsWith As String = vbNullString, _
Optional BeginEndCompare As VbCompareMethod = vbTextCompare) As Range
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FindAll
' This searches the range specified by SearchRange and returns a Range object
' that contains all the cells in which FindWhat was found. The search parameters to
' this function have the same meaning and effect as they do with the
' Range.Find method. If the value was not found, the function return Nothing. If
' BeginsWith is not an empty string, only those cells that begin with BeginWith
' are included in the result. If EndsWith is not an empty string, only those cells
' that end with EndsWith are included in the result. Note that if a cell contains
' a single word that matches either BeginsWith or EndsWith, it is included in the
' result. If BeginsWith or EndsWith is not an empty string, the LookAt parameter
' is automatically changed to xlPart. The tests for BeginsWith and EndsWith may be
' case-sensitive by setting BeginEndCompare to vbBinaryCompare. For case-insensitive
' comparisons, set BeginEndCompare to vbTextCompare. If this parameter is omitted,
' it defaults to vbTextCompare.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FoundCell As Range
Dim FirstFound As Range
Dim LastCell As Range
Dim ResultRange As Range
Dim XLookAt As XlLookAt
Dim Include As Boolean
Dim CompMode As VbCompareMethod
Dim Area As Range
Dim MaxRow As Long
Dim MaxCol As Long
CompMode = BeginEndCompare
If BeginsWith <> vbNullString Or EndsWith <> vbNullString Then
XLookAt = xlPart
Else
XLookAt = LookAt
End If
' this loop in Areas is to find the last cell
' of all the areas. That is, the cell whose row
' and column are greater than or equal to any cell
' in any Area.
For Each Area In SearchRange.Areas
With Area
If .Cells(.Cells.Count).Row > MaxRow Then
MaxRow = .Cells(.Cells.Count).Row
End If
If .Cells(.Cells.Count).Column > MaxCol Then
MaxCol = .Cells(.Cells.Count).Column
End If
End With
Next Area
Set LastCell = SearchRange.Worksheet.Cells(MaxRow, MaxCol)
Set FoundCell = SearchRange.Find(what:=FindWhat, _
after:=LastCell, _
LookIn:=LookIn, _
LookAt:=XLookAt, _
SearchOrder:=SearchOrder, _
MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then
Set FirstFound = FoundCell
Set ResultRange = FoundCell
Set FoundCell = SearchRange.FindNext(after:=FoundCell)
Do Until False ' Loop forever. We'll "Exit Do" when necessary.
If (FoundCell Is Nothing) Then
Exit Do
End If
If (FoundCell.Address = FirstFound.Address) Then
Exit Do
End If
Include = False
If BeginsWith = vbNullString Then
If EndsWith = vbNullString Then
Include = True
Else
If Len(FoundCell.Text) < Len(EndsWith) Then
Include = False
Else
If StrComp(Right(FoundCell.Text, Len(EndsWith)), EndsWith, CompMode) = 0 Then
Include = True
Else
Include = False
End If
End If
End If
End If
If EndsWith = vbNullString Then
If BeginsWith = vbNullString Then
Include = True
Else
If StrComp(Left(FoundCell.Text, Len(BeginsWith)), BeginsWith, CompMode) = 0 Then
Include = True
Else
Include = False
End If
End If
Else
If Len(FoundCell.Text) < Len(EndsWith) Then
Include = False
Else
If StrComp(Right(FoundCell.Text, Len(EndsWith)), EndsWith, CompMode) = 0 Then
Include = True
Else
Include = False
End If
End If
End If
If Include = True Then
Set ResultRange = Application.Union(ResultRange, FoundCell)
End If
Set FoundCell = SearchRange.FindNext(after:=FoundCell)
Loop
End If
Set FindAll = ResultRange
End Function

复制代码

原帖
http://club.excelhome.net/forum. ... =843516&pid=5762275

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

一个FindAll函数，谁有时间看看写得怎么样？

评分