Завершить перенос .FindNext без цикла?
Я новичок в vba и создаю электронную таблицу CRM для небольшой компании. У меня есть рабочий лист с именами компаний/клиентов, и я пытаюсь извлечь их контактную информацию из другого рабочего листа и показать ее во всплывающей пользовательской форме.
Моя пользовательская форма перечисляет индивидуальную контактную информацию с текстовыми полями, поэтому я использую функции .Find/FindNext для их заполнения. Но FindNext продолжает возвращаться к началу, в результате чего в пользовательской форме снова отображаются те же имена.
Как остановить перенос .FindNext без использования цикла?
Я пытался поместить его в Do-Loop, но это, кажется, помещает его в бесконечный цикл или что-то в этом роде, и Excel зависает. Я также безуспешно пробовал формулу LastRow.
Sub UserForm_Activate()
Dim fSearch As Range 'the column we are searching in
Dim fFind As Range 'the value we are searching for
Dim LastRow As Long
Set fSearch = Sheets("Contact List").Range("Company_Find")
'First Find
Set fFind = fSearch.Find(What:=Selection.Value)
Debug.Print
Txt_Contact1 = fFind.Offset(0, 5)
Txt_Title1 = fFind.Offset(0, -1)
Txt_Email1 = fFind.Offset(0, 1)
Txt_Office1 = fFind.Offset(0, 2)
Txt_Mobile1 = fFind.Offset(0, 3)
'Second Find
Set fFind = fSearch.FindNext(fFind)
Debug.Print
Txt_Contact2 = fFind.Offset(0, 5)
Txt_Title2 = fFind.Offset(0, -1)
Txt_Email2 = fFind.Offset(0, 1)
Txt_Office2 = fFind.Offset(0, 2)
Txt_Mobile2 = fFind.Offset(0, 3)
'Third Find
Set fFind = fSearch.FindNext(fFind)
Debug.Print
Txt_Contact3 = fFind.Offset(0, 5)
Txt_Title3 = fFind.Offset(0, -1)
Txt_Email3 = fFind.Offset(0, 1)
Txt_Office3 = fFind.Offset(0, 2)
Txt_Mobile3 = fFind.Offset(0, 3)
'Fourth Find
'Fifth Find
End Sub
Ответы 1
Set fFind = fSearch.Find(What:=Selection.Value)
If Not fFind Is Nothing Then
'Save the address of the first found range to compare with later
Fadd = fFind.Address
End If
Do While Not fFind Is Nothing
'Do stuff
Set fFind = fSearch.FindNext(fFind)
If Not fFind is Nothing Then
'If the next found address is the same as the first, stop searching, exit the loop
If fFind.Address = Fadd Then Exit Do
End If
Loop
Это мой метод. Надеюсь, поможет. Я полагаю, что вы неправильно вышли из своего Do...Loop, отсюда и бесконечные циклы, которые убили Excel.
Этот цикл завершится, если вы не измените значение первого найденного диапазона.
Гораздо лучше использовать цикл, чем писать метод Find каждый раз, когда вам придется искать. Это приводит к жестко закодированному «циклу» поиска без гибкости в итерациях.
РЕДАКТИРОВАТЬ
Приведенный ниже код будет зацикливаться, чтобы заполнить все текстовые поля в UF, и выйти из цикла, как только все будут заполнены / новые значения не будут найдены.
Dim ctrl as Control
Dim b as Integer
Set fFind = fSearch.Find(What:=Selection.Value)
If Not fFind Is Nothing Then
b = 1
'Save the address of the first found range to compare with later
Fadd = fFind.Address
End If
Do While Not fFind Is Nothing
For Each ctrl In Me.Controls
If ctrl.Name Like "Txt_Contact" & b And ctrl.Value = "" Then ctrl.Value = fFind.Offset(0, 5)
If ctrl.Name Like "Txt_Title" & b And ctrl.Value = "" Then ctrl.Value = fFind.Offset(0, -1)
If ctrl.Name Like "Txt_Email" & b And ctrl.Value = "" Then ctrl.Value = fFind.Offset(0, 1)
If ctrl.Name Like "Txt_Office" & b And ctrl.Value = "" Then ctrl.Value = fFind.Offset(0, 2)
If ctrl.Name Like "Txt_Mobile" & b And ctrl.Value = "" Then ctrl.Value = fFind.Offset(0, 3)
Next ctrl
Set fFind = fSearch.FindNext(fFind)
If Not fFind is Nothing Then
'If the next found address is the same as the first, stop searching, exit the loop
If fFind.Address = Fadd Then Exit Do
End If
b = b + 1
Loop
Я добавил кусок кода в свой ответ. Надеюсь, это поможет @CFWalker. Обратите внимание, что если количество находок превышает количество текстовых полей, эти находки будут исключены.
Похоже, это должно работать, но я продолжаю получать сообщение об ошибке: «Объект не поддерживает это свойство или метод» в строках If ctrl.Name. Я не слишком знаком с функциями управления. Я что-то пропустил?
О, я понял, что с помощью If ctrl.Name Like "Txt_Contact" & b = True Then ctrl.Value = fFind.Offset(0, 5) работает. Спасибо Тим!!
Спасибо, Тим, твое предложение помогло с бесконечным циклом! Но я все еще пытаюсь понять, как завершить поиск, когда не осталось уникальных значений. Есть ли у вас какие-либо предложения о том, как завершить поиск FindNext, когда все новые находки исчерпаны? Моя пользовательская форма может содержать 5 поисковых значений, но если в поиске найдено менее 5, они повторяются, заполняя все 5 пробелов. Спасибо!