学习Excel技术，关注微信公众号：
excelperfect
这里的应用场景如下：
“在工作表Sheet1中存储着数据，现在想要在该工作表的第O列至第T列中搜索指定的数据，如果发现，则将该数据所在行复制到工作表Sheet2中。
用户在一个对话框中输入要搜索的数据值，然后自动将满足前面条件的所有行复制到工作表Sheet2中。”
首先，使用用户窗体设计输入对话框，如下图1所示。
图1
在该用户窗体模块中编写代码：
代码语言：javascript复制Private Sub cmdOK_Click()
Dim wks As Worksheet
Dim lngRow As Long
Dim rngSearch As Range
Dim FindWhat As Variant
Dim rngFoundCells As Range
Dim rngFoundCell As Range
Dim lngCurRow As Long
Application.ScreenUpdating = False
'赋值为工作表Sheet1
Set wks = Worksheets("Sheet1")
With wks
'工作表中的最后一个数据行
lngRow = .Range("A" &Rows.Count).End(xlUp).Row
'被查找的单元格区域
Set rngSearch = .Range("O2:T"& lngRow)
'查找的数据文本值
'由用户在文本框中输入
FindWhat = "*" &Me.txtSearch.Text & "*"
'调用FindAll函数查找数据值
'存储满足条件的所有单元格
Set rngFoundCells =FindAll(SearchRange:=rngSearch, _
FindWhat:=FindWhat,_
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
MatchCase:=False, _
BeginsWith:=vbNullString, _
EndsWith:=vbNullString, _
BeginEndCompare:=vbTextCompare)
'如果没有找到则给出消息
If rngFoundCells Is Nothing Then
GoTo SendInfo
End If
'清空工作表Sheet2
Sheets("Sheet2").Cells.Clear
'获取数据单元格所在的行并复制到工作表Sheet2
For Each rngFoundCell In rngFoundCells
lngCurRow =Val(Mid(rngFoundCell.Address, 4, Len(rngFoundCell.Address)))
Range("A" &lngCurRow & ":Z" & lngCurRow).Copy _
Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
Next rngFoundCell
End With
Application.ScreenUpdating = True
Unload Me
Exit Sub
SendInfo:
MsgBox "没有找到数据", , "查找"
End Sub代码中使用的FindAll函数代码如下：
代码语言：javascript复制'自定义函数
'获取满足条件的所有单元格
Function FindAll(SearchRange AsRange, _
FindWhat As Variant, _
Optional LookIn As XlFindLookIn= xlValues, _
Optional LookAt As XlLookAt =xlWhole, _
Optional SearchOrder AsXlSearchOrder = xlByRows, _
Optional MatchCase As Boolean =False, _
Optional BeginsWith As String =vbNullString, _
Optional EndsWith As String =vbNullString, _
Optional BeginEndCompare AsVbCompareMethod = vbTextCompare) As Range
Dim FoundCell As Range
Dim FirstFound As Range
DimLastCell 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
Dim BeginB As Boolean
Dim EndB As Boolean
CompMode = BeginEndCompare
If BeginsWith <> vbNullString OrEndsWith <> vbNullString Then
XLookAt = xlPart
Else
XLookAt = LookAt
End If
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)
On Error GoTo 0
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
Do Until False
Include = False
If BeginsWith = vbNullString AndEndsWith = vbNullString Then
Include = True
Else
If BeginsWith <>vbNullString Then
IfStrComp(Left(FoundCell.Text, Len(BeginsWith)), BeginsWith, BeginEndCompare) = 0Then
Include = True
End If
End If
If EndsWith <>vbNullString Then
If StrComp(Right(FoundCell.Text,Len(EndsWith)), EndsWith, BeginEndCompare) = 0 Then
Include = True
End If
End If
End If
If Include = True Then
If ResultRange Is Nothing Then
Set ResultRange = FoundCell
Else
Set ResultRange =Application.Union(ResultRange, FoundCell)
End If
End If
Set FoundCell = SearchRange.FindNext(after:=FoundCell)
If (FoundCell Is Nothing) Then
Exit Do
End If
If (FoundCell.Address =FirstFound.Address) Then
Exit Do
End If
Loop
End If
Set FindAll = ResultRange
End Function这是一个通用函数，直接拿来使用就行了，可用来在指定的区域查找并返回满足条件的所有单元格。
上述两段代码的图片版如下：
