搜索一個字符串「datatoFind」超出第一個出現

Question

我剛剛發佈了這個代碼昨天與一個不同的問題，這簡單地解決了（謝謝！）。我正在嘗試使用宏來搜索某個字符串的Excel文檔。我想獲取找到字符串的單元格的地址，並將它們一個接一個地放在當前工作表的第i列中。我的問題是宏只識別字符串的第一次出現，並不識別其他實例，即使我知道它們存在。我的代碼如下。

Option Explicit 

Sub Find_Data() 

Dim datatoFind As String 
Dim rangeSearch As Range 
Dim rangeLast As Range 
Dim foundRange As Range 
Dim strFirstAddress As String 
Dim sheetCount As Integer 
Dim sheetCounter As Integer 
Dim currentSheet As Integer 
Dim foundmatrixCounter As Integer 
foundmatrixCounter = 2 'initialize this to the second row so the total can be placed in the first row when done 

'set search range 
Set rangeSearch = ActiveSheet.Range("B2:X100") 

'set last cell in range 
Set rangeLast = rangeSearch.Cells(rangeSearch.Cells.Count) 

currentSheet = ActiveSheet.Index 
datatoFind = InputBox("Please enter the value to search for") 
If datatoFind = "" Then Exit Sub 
sheetCount = ActiveWorkbook.Sheets.Count 

For sheetCounter = 1 To sheetCount 
    Sheets(sheetCounter).Activate 
    Set foundRange = Cells.Find(What:=datatoFind, After:=Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) 
    'if datatoFind is found in search range 
    If Not foundRange Is Nothing Then 
     'save the address of the first occurrence of datatoFind, in the strFirstAddress variable 
     strFirstAddress = foundRange.Address 
     Do 
      'Find next occurrence of datatoFind 
      Set foundRange = foundRange.FindNext(foundRange) 
      'Place the address of this occurrence in the next cell down in the column that holds found values (i column) 
      Cells(foundmatrixCounter, 9).Value = foundRange.Address 
      'Increment the loop counter for the i column 
      foundmatrixCounter = foundmatrixCounter + 1 
      'The Loop ends on reaching the first occurrence of datatoFind 
     Loop Until foundRange.Address = strFirstAddress 
    End If 
    Cells(1, 9).Value = foundmatrixCounter 'Put the total number of instances, in this case foundmatrixCounter, in Z1 
Next sheetCounter 

If foundRange Is Nothing Then 
MsgBox ("Value not found") 
Sheets(currentSheet).Activate 
End If 
End Sub 

可能還有一些其他的錯誤，我對VBA相當陌生。任何幫助將非常感激。

Answer 1

將包含數據的單元格的所有地址轉儲到稱爲「結果」的新工作表中。每次搜索前清除結果頁面。

Sub Find_Data() 

Dim datatoFind As String 
Dim CurSht As Worksheet, wsTest As Worksheet 
Dim rangeSearch As Range, cel As Range 
Dim LastRow As Long, LastCol As Long 
Dim FoundCount As Integer 

Application.ScreenUpdating = False 

Set wsTest = Nothing 
On Error Resume Next 
Set wsTest = ActiveWorkbook.Sheets("Results") 
On Error GoTo 0 

If wsTest Is Nothing Then 
    Worksheets.Add.Name = "Results" 
End If 

datatoFind = InputBox("Please enter the value to search for") 
If datatoFind = "" Then 
    Exit Sub 
Else 

'Clear the Results Sheet 
Sheets("Results").Cells.Clear 

FoundCount = 0 
For Each CurSht In ActiveWorkbook.Sheets 
    If CurSht.Name = "Results" Then 
     'Do Nothing 
    Else 
     Set rangeSearch = CurSht.Range("B2:X100") 
     For Each cel In rangeSearch 
      If cel.Value Like "*" & datatoFind & "*" Then 
       LastRow = Sheets("Results").Range("A" & Rows.Count).End(xlUp).Row + 1 
       Sheets("Results").Range("A" & LastRow).Value = cel.Address 
       FoundCount = FoundCount + 1 
      End If 
     Next cel 
    End If 
Next CurSht 
Sheets("Results").Range("A1").Value = FoundCount & " values found of " & datatoFind 

If FoundCount = 0 Then 
MsgBox (datatoFind & " not found") 
End If 
Application.ScreenUpdating = True 
Sheets("Results").Activate 

End Sub