|
关于查找方法(Find方法)的应用(续)
5.4 示例四：本示例所列程序将在工作簿的所有工作表中查找数值，提供了采用两种方法编写的程序，一种是Find方法，另一种是SpecialCells 方法。相对来说，使用Find方法比使用SpecialCells方法要快，当然，本示例可能不明显，但对于带大量工作表和数据的工作簿来说，这种速度差异就可以看出来了。(by fanjy from vbaexpress.com)。
示例代码如下，代码中有简要的说明。
‘- - -使用Find方法 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Sub QuickSearch()
Dim wks As Excel.Worksheet
Dim rCell As Excel.Range
Dim szFirst As String
Dim i As Long
'设置变量决定是否加亮显示查找到的单元格
'该变量为真时则加亮显示
Dim bTag As Boolean
bTag = True
'使用input接受查找条件的输入
Dim szLookupVal As String
szLookupVal = InputBox("在下面的文本框中输入您想要查找的值", "查找输入框", "") '如果没有输入任何数据,则退出程序
If szLookupVal = "" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' =============================================================
' 添加一个工作表,在该工作表中放置已查找到的单元格地址
' 如果该工作表存在,则先删除它
For Each wks In ActiveWorkbook.Worksheets
If wks.Name = "查找结果" Then
wks.Delete
End If
Next wks
' 添加工作表
Sheets.Add ActiveSheet
' 重命名所添加的工作表
ActiveSheet.Name = "查找结果"
' 在新增工作表中添加标题,指明所查找的值
With Cells(1, 1)
.Value = "已在下面所列出的位置找到数值" & szLookupVal
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
End With
' =============================================================
' 定位到刚开始的工作表
ActiveSheet.Next.Select
' =============================================================
' 提示您是否想高亮显示已查找到的单元格
If MsgBox("您想加阴影高亮显示所有查找到的单元格吗?", vbYesNo, _
"加阴影高亮显示单元格") = vbNo Then
' 如果不想加阴影显示单元格,则将变量bTag值设置为False
bTag = False
End If ' =============================================================
i = 2
' 开始在工作簿的所有工作表中搜索
For Each wks In ActiveWorkbook.Worksheets
' 检查所有的单元格,Find方法比SpecialCells方法更快
With wks.Cells
Set rCell = .Find(szLookupVal, , , xlWhole, xlByColumns, xlNext, False)
If Not rCell Is Nothing Then
szFirst = rCell.Address
Do
' 添加找到的单元格地址到新工作表中
rCell.Hyperlinks.Add Sheets("查找结果").Cells(i, 1), "", "'" & wks.Name & "'!" & rCell.Address
' 检查条件判断值bTag,以决定是否加亮显示单元格
Select Case bTag
Case True
rCell.Interior.ColorIndex = 19
End Select
Set rCell = .FindNext(rCell)
i = i + 1
Loop While Not rCell Is Nothing And rCell.Address <> szFirst
End If
End With
Next wks ' 释放内存变量
Set rCell = Nothing
' 如果没有找到匹配的值,则移除新增工作表
If i = 2 Then
MsgBox "您所要查找的数值{" & szLookupVal & "}在这些工作表中没有发现", 64, "没有匹配值"
Sheets("查找结果").Delete
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
‘- - - 使用SpecialCells 方法- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Option Compare Text
Sub SlowerSearch()
Dim wks As Excel.Worksheet
Dim rCell As Excel.Range
Dim i As Long
'设置变量决定是否加亮显示查找到的单元格
'该变量为真时则加亮显示
Dim bTag As Boolean
bTag = True
'使用input接受查找条件的输入
Dim szLookupVal As String
szLookupVal = InputBox("在下面的文本框中输入您想要查找的值", "查找输入框", "")
'如果没有输入任何数据,则退出程序
If szLookupVal = "" Then Exit Sub
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
' =============================================================
' 添加一个工作表,在该工作表中放置已查找到的单元格地址
' 如果该工作表存在,则先删除它
For Each wks In ActiveWorkbook.Worksheets
If wks.Name = "查找结果" Then
wks.Delete
End If
Next wks
' 添加工作表
Sheets.Add ActiveSheet
' 重命名所添加的工作表
ActiveSheet.Name = "查找结果"
' 在新增工作表中添加标题,指明所查找的值
With Cells(1, 1)
.Value = "已在下面所列出的位置找到数值" & szLookupVal
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
End With
' =============================================================
' 定位到刚开始的工作表
ActiveSheet.Next.Select
' =============================================================
' 提示您是否想高亮显示已查找到的单元格
If MsgBox("您想加阴影高亮显示所有查找到的单元格吗?", vbYesNo, _
"加阴影高亮显示单元格") = vbNo Then
' 如果不想加阴影显示单元格,则将变量bTag值设置为False
bTag = False
End If
' =============================================================
i = 2
' 开始在工作簿的所有工作表中搜索
On Error Resume Next
For Each wks In ActiveWorkbook.Worksheets
If wks.Cells.SpecialCells(xlCellTypeConstants).Count = 0 Then GoTo NoSpecCells
For Each rCell In wks.Cells.SpecialCells(xlCellTypeConstants)
DoEvents
If rCell.Value = szLookupVal Then
' 添加找到的单元格地址到新工作表中
rCell.Hyperlinks.Add Sheets("查找结果").Cells(i, 1), "", "'" & wks.Name & "'!" & rCell.Address
' 检查条件判断值bTag,以决定是否加亮显示单元格
Select Case bTag
Case True
rCell.Interior.ColorIndex = 19
End Select
i = i + 1
.StatusBar = "查找到的单元格数为: " & i - 2
End If
Next rCell
NoSpecCells:
Next wks
' 如果没有找到匹配的值,则移除新增工作表
If i = 2 Then
MsgBox "您所要查找的数值{" & szLookupVal & "}在这些工作表中没有发现", 64, "没有匹配值"
Sheets("查找结果").Delete
End If
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
.ScreenUpdating = True
.StatusBar = Empty
End With
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
示例文档见 Find与SpecialCells查找示例.xls。
dBLmL05n.rar
(16.6 KB, 下载次数: 460)
[此贴子已经被作者于2006-9-28 21:45:08编辑过] | 
楼主: fanjy
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
楼主
图05 数据及查找结果
发表于 2006-9-28 21:22
