[VBA]關於查找方法(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。UploadFiles/2006-9/928569799.rar

---

6. 其它一些查找方法
可以使用For Each … Next語句和Like運算符進行更精確匹配的查找。例如，下列代碼在單元格區域A1:A10中查找以字符“我”開頭的單元格，並將其背景色變為紅色。
‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Sub test()
  Dim Cell As Range
  For Each Cell In [A1:A10]
    If Cell Like "我*" Then
        Cell.Interior.ColorIndex = 3
    End If
  Next
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
可以輸入下圖06所示的數據進行測試。

 

 圖06:測試的數據

By fanjy in 2006-9-28

****************************************************************************************

 

hner發表評論於2006-10-10 21:39:54

Find方法應用三已看完，對於實例四總結如下：
主要功能：在工作簿的所有工作表中查找數據，並提示是否高亮顯示數據，查找數據地址在“查找結果”工作表中反應。
1、判斷工作簿中是否存在"查找結果"工作表，如果存在則刪除
2、新增一個工作表，改名"查找結果"
3、利用find方法在每個工作表中查找數值
4、根據新增工作表行數有無變化來判斷是否找到數據，如果沒有找到，則刪除新增的查找結果工作表

代碼如下：
Sub DifWsFind()
'在不同工作表中查找數值，並將查找結果地址在查找結果工作表中反映，原數值高亮顯示
Dim Ws As Worksheet
Dim FlagWs As Worksheet
Dim FindWs As Worksheet
Dim c As Range
Dim FindValue As Long
Dim FirstAddress As String
Dim Irow As Integer
Dim t As String
'當mboolean為true時，查找結果要高亮顯示
Mboolean = True

Irow = 1
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'1、判斷工作簿中是否存在"查找結果"工作表，如果存在則刪除
For Each FlagWs In ThisWorkbook.Worksheets
If FlagWs.Name = "查找結果" Then
FlagWs.Delete
Exit For
End If
Next FlagWs
'2、新增一個工作表，改名"查找結果"
Set FindWs = Worksheets.Add
FindWs.Name = "查找結果"
FindValue = Val(InputBox("輸入要查找的數值：", "輸入框"))


If Len(FindValue) = 0 Then End
t = MsgBox("查找結果是否要高亮顯示？", vbYesNo, "顯示提示")
For Each FlagWs In ThisWorkbook.Worksheets
If FlagWs.Name <> FindWs.Name Then
'3、在每個工作表中查找數值
FlagWs.Cells.Interior.Color = vbWhite
Set c = FlagWs.Cells.Find(what:=FindValue, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
Irow = Irow + 1
With FindWs
.Range("a1") = "查找數值:" & FindValue & "所在地址如下:"
c.Hyperlinks.Add FindWs.Cells(Irow, 1), "", "'" & FlagWs.Name & "'!" & c.Address
If t = vbYes Then
c.Interior.Color = RGB(200, 100, 45)
End If


End With
Set c = FlagWs.Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End If
Next FlagWs
'4、根據新增工作表行數有無變化來判斷是否找到數據，如果沒有找到，則刪除新增的查找結果工作表
If Irow = 1 Then
MsgBox "沒有查到需要查找的數值" & FindValue
FindWs.Delete
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

通過本實例有如下疑問：
1、由於本人系統重裝，原來在vbe中選擇某方法，按F1可以出現幫助，但現在不可以了，我記得要安裝MSDN的！是不是？
2、認識了超級鏈接，不過沒有幫助還是不得要領，只能照貓畫虎，他們的參數沒有像FIND方法領略
3、Specialcells在excel中相當於ctrl+g編輯定位功能，它只能定位某些單元格，並非查找！樓主SpecialCells(xlCellTypeConstants)運用它只能定位常量，如果數據全部為常量，則查找的數據要遍布工作表中所有有數據的單元格，運行速度因該很慢，但是摟住的速度比我想象的要快！是不是我理解錯了？
for each icell in wks.cells.SpecialCells(xlCellTypeConstants)
我認為相當於
for each icell in wks.cells.usedrange
4、對like認識不夠！樓主有沒有這方面的專題？
5、樓主什么時候講解以下sorts在vba中的應用？