VBA Range.FindNext просто находит следующую ячейку, а не следующий поисковый запрос - PullRequest
0 голосов
/ 02 мая 2020

Я все еще новичок в VBA и решил, что попробую научить себя методу Range.FindNext. К сожалению, пока я не очень успешен.

Я пытаюсь скопировать все строки с определенным c поисковым термином в них на новый лист (может быть любым, поэтому может быть объявлен как Variant). Важно то, что поисковый термин может быть только частью значения ячейки, поэтому я использую xlPart в моем Range.Find методе.

Вот пример данных из моего ActiveWorkbook.ActiveSheet:

Date        Name        Numbers
12.04.2012  Marla       45653
13.04.2017  Peter       23545
27.04.1985  Bertrud     46932
16.08.2020  Peterson    46764
15.09.2014  Marcos      32465
21.06.2010  Peter Pan   23452
31.08.2013  Bernard     12321

Итак, при поиске «Питер» я должен получить строки 3, 5 и 7 на новом листе. Вот код, который я написал для этого:

Option Explicit
Dim wsMain, wsNew As Worksheet
Dim rgAll, rgSearchTermFind As Range
Dim varSearchTerm As Variant
Dim lngLastRow, lngLastColumn As Long
Dim firstAddress As String

Public Sub FindAndCopy()

'I have an InputBox for the user to determine the varSearchTerm, but for this example:
varSearchTerm = "Peter"

Set wsMain = ActiveWorkbook.ActiveSheet    
Set wsNew = Sheets.Add(After:=Worksheets(Sheets.Count))

Call FindLast(wsMain) 'This is a separate sub I wrote to find the last row & column
With wsMain
    Set rgAll = .Range(.Cells(1, 1), .Cells(lngLastRow, lngLastColumn))
End With

With rgAll
    Set rgSearchTermFind = .Find(What:=varSearchTerm, _
                                    LookIn:=xlValues, _
                                    LookAt:=xlPart, _
                                    SearchOrder:=xlNext, _
                                    MatchCase:=False)

    If Not rgSearchTermFind Is Nothing Then
        firstAddress = rgSearchTermFind.Address

        Do
            'Copy row to new sheet
            If Application.WorksheetFunction.CountA(wsNew.Cells) <> 0 Then
                Call FindLast(wsNew) 'This is a separate sub I wrote to find the last row & column
                wsMain.Range(rgSearchTermFind.Address).EntireRow.Copy _
                Destination:=wsNew.Cells(lngLastRow + 1, 1)
            Else
                wsMain.Range(rgSearchTermFind.Address).EntireRow.Copy _
                Destination:=wsNew.Cells(1, 1)
            End If

            'Find next occurrence of search term
            Set rgSearchTermFind = .FindNext(rgSearchTermFind)
        Loop Until rgSearchTermFind.Address = firstAddress
    Else
        'Code here to execute if search term could not be found
    End If 
End With
End Sub

При запуске этого кода начальный метод Range.Find находит Питера в B3, но затем Range.FindNext находит «Бертруду» в B4 и копирует его. Это происходит для каждой ячейки в диапазоне, оставляя меня в конце с таблицей, скопированной три раза на новом листе (из-за наличия трех столбцов).

Что я делаю неправильно? Любая помощь будет высоко ценится.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...