Я все еще новичок в 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 и копирует его. Это происходит для каждой ячейки в диапазоне, оставляя меня в конце с таблицей, скопированной три раза на новом листе (из-за наличия трех столбцов).
Что я делаю неправильно? Любая помощь будет высоко ценится.