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

将包含数据的单元格的所有地址转储到名为＆＃34;结果＆＃34;的新工作表中。在每次搜索之前清除结果页面。

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

在第一次出现之后搜索工作簿中的字符串“datatoFind”

1 个答案: