搜索一个字符串“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