Найти слово в диапазоне и найти его снова до конца диапазона - PullRequest
Новая
       40

Найти слово в диапазоне и найти его снова до конца диапазона

0 голосов
/ 08 октября 2019

Мне нужно Find слово в Range("A1:A7500"), затем Find это снова до конца Range (точно так же, как MSword VBA). Всякий раз, когда слово найдено, мне нужно что-то с ним сделать, или вы можете сказать подсчитать вхождение.

Но проблема в том, что Range изменится, когда будет найден текст. Итак, как я могу сбросить свой диапазон со следующей строки, где текст найден до конца? или есть ли другой способ получить тот же результат? 

    Dim FIN,FOUN As Range
    Set FIN = Sheets("Sheet2").Range("A1:A7500")
    Do
    Set FOUN = FIN.find("TEXT", LookIn:=xlValues)

     ' IF FOUND THEN DO SOMETHING HERE

    Loop

Ответы [ 2 ]

1 голос
/ 08 октября 2019

Я бы сделал это с помощью универсальной функции FindAll.

Например: 

Sub FindTest()
    Dim r As Range, Cell As Range
    Set r = FindAll("Test", Sheets("Sheet2").Range("A1:A7500"), LookAt:=xlPart)

    If Not r Is Nothing Then
        Debug.Print r.Count
        For Each Cell In r
            Cell.value = "Test2"
        Next Cell
    End If
End Sub

Private Function FindAll(What, _
    Optional SearchWhat As Variant, _
    Optional LookIn, _
    Optional LookAt, _
    Optional SearchOrder, _
    Optional SearchDirection As XlSearchDirection = xlNext, _
    Optional MatchCase As Boolean = False, _
    Optional MatchByte, _
    Optional SearchFormat, _
    Optional IncludeMerged As Boolean = False) As Range

    'LookIn can be xlValues or xlFormulas, _
     LookAt can be xlWhole or xlPart, _
     SearchOrder can be xlByRows or xlByColumns, _
     SearchDirection can be xlNext, xlPrevious, _
     MatchCase, MatchByte, and SearchFormat can be True or False. _
     Before using SearchFormat = True, specify the appropriate settings for the Application.FindFormat _
     object; e.g. Application.FindFormat.NumberFormat = "General;-General;""-""" _
     Set IncludeMerged to 'True' to include all cells within a merged area

    Dim SrcRange As Range
    If IsMissing(SearchWhat) Then
        Set SrcRange = ActiveSheet.UsedRange
    ElseIf TypeOf SearchWhat Is Range Then
        Set SrcRange = IIf(SearchWhat.Cells.Count = 1, SearchWhat.Parent.UsedRange, SearchWhat)
    ElseIf TypeOf SearchWhat Is Worksheet Then
        Set SrcRange = SearchWhat.UsedRange
    Else: SrcRange = ActiveSheet.UsedRange
    End If
    If SrcRange Is Nothing Then Exit Function

    'get the first matching cell in the range first
    With SrcRange.Areas(SrcRange.Areas.Count)
        Dim FirstCell As Range: Set FirstCell = .Cells(.Cells.Count)
    End With

    Dim CurrRange As Range: Set CurrRange = SrcRange.Find(What:=What, After:=FirstCell, LookIn:=LookIn, LookAt:=LookAt, _
        SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)

    If Not CurrRange Is Nothing Then
        Set FindAll = IIf(IncludeMerged = True, CurrRange.MergeArea, CurrRange)
        Do
            Set CurrRange = SrcRange.Find(What:=What, After:=CurrRange, LookIn:=LookIn, LookAt:=LookAt, _
            SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)
            If CurrRange Is Nothing Then Exit Do
            If Application.Intersect(FindAll, CurrRange) Is Nothing Then
                Set FindAll = Application.Union(FindAll, IIf(IncludeMerged = True, CurrRange.MergeArea, CurrRange))
            Else: Exit Do
            End If
        Loop
    End If
End Function
1 голос
/ 08 октября 2019

Попробуйте это: 

Sub FindAndChange()

    Dim oWS As Worksheet: Set oWS = ThisWorkbook.Worksheets("Sheet3")   ' <- change the worksheet to point to your sheet
    Dim iLastRow As Long: iLastRow = oWS.Range("A" & oWS.Rows.Count).End(xlUp).Row
    Dim oRng As Range: Set oRng = oWS.Range("A1:A" & iLastRow)          ' <- change the column name if its not column A
    Dim oFoundRng As Range, oLastRng As Range
    Dim sTextToFind As String: sTextToFind = "test"

    ' Find the first instance of the text to find
    Set oFoundRng = oRng.Find(sTextToFind)

    ' Loop to find all instances of the text
    Do While Not oFoundRng Is Nothing

        oFoundRng.Value = "Found test"              ' Change the text to whatever it is you want to here
        Set oLastRng = oFoundRng                    ' Assign the current range to last range so that we dont go into an endless loop
        Set oFoundRng = oRng.FindNext(oFoundRng)    ' Find the next instance of the text
        If oLastRng >= oFoundRng Then               ' Ensure we dont start from the top again
            Exit Do                                 ' We are back at the top so exit loop
        End If
    Loop

    ' Clear objects
    Set oFoundRng = Nothing
    Set oWS = Nothing

End Sub
...