Здравствуйте. У меня есть макрос, который ищет в других файлах (всё прописано и работает) указанное слово (через Inputbox) и найдя его в книге, откуда он был запущен, записывает значения соседних ячеек (соседних с ячейкой книги в которой он нашёл заданное слово). Поиск осуществляется так:
Код
Set Rng = Sht.Cells.Find(d, , xlFormulas, xlWhole)
, где d - это слово, введённое в Inputbox. Проблема в том, что заданное слово может встречаться несколько раз на листе, но макрос обрабатывает только первое нахождение (записывает нужные мне значения соседних ячеек), и дальше идёт искать в другой книге. Как заставить его обработать все нахождения указанного слова на листе?
Sub Test()
Dim text As String, Rng As Range, firstAddress As String
text = "мама" 'текст для поиска на листе
With ActiveSheet.Cells
Set Rng = .Find(What:=text, LookIn:=xlFormulas, LookAt:=xlWhole) 'ищем слово на листе
If Rng Is Nothing Then
MsgBox "Значение '" & text & "' не найдено на листе!", vbExclamation, "Внимание"
Exit Sub
End If
firstAddress = Rng.Address 'запоминаем адрес первой найденной ячейки
Do
'что-то делаем с найденной ячейкой
MsgBox "Текст '" & text & "' найден в ячейке: " & Rng.Address(0, 0), vbInformation, "Поиск"
Set Rng = .FindNext(Rng) 'ищем следующую ячейку на листе
Loop Until firstAddress = Rng.Address 'повторяем цикл, пока не вернёмся к первой найденной ячейки
End With
MsgBox "Поиск завершён!", vbInformation, "Конец поиска"
End Sub
Set Rng = Sht.Cells.Find(d, , xlFormulas, xlWhole) 'xlWhole - ячейка целиком, xlPart - часть ячейки
If Not Rng Is Nothing Then 'если нашли
'MsgBox "Найдено на листе " & Rng.Parent.Name & " в ячейке " & Rng.Address(0, 0), vbInformation, "Конец"
firstAddress = Rng.Address 'запоминаем адрес первой найденной ячейки
u = Rng.Address
g = u.Row
h = u.Column
Do
MsgBox "Найдено на листе " & Rng.Parent.Name & " в ячейке " & Rng.Address(0, 0), vbInformation, "Конец"
If Workbooks(p & f).Sheets(1).Range(g, h + 5).Value <> "Да" Or Workbooks(p & f).Sheets(1).Range(g, h + 5).Value <> "ДА" Or Workbooks(p & f).Sheets(1).Range(g, h + 5).Value <> "да" Then
For i = 1 To Rng
If Workbooks(p & f).Sheets(1).Range(g, h) = Workbooks(p & f).Sheets(1).Range("D" & g) Then
MsgBox (Workbooks(p & f).Sheets(1).Range(g, h - 3).Value)
Workbooks("Поиск.xlsm").Range("B" & i).Value = Workbooks(f).Range(g - 3, h).Value
Workbooks("Поиск.xlsm").Range("C" & i).Value = Workbooks(f).Range(g - 1, h).Value
Workbooks("Поиск.xlsm").Range("D" & i).Value = Workbooks(f).Range(g + 2, h).Value
Workbooks("Поиск.xlsm").Range("E" & i).Value = Workbooks(f).Range(g + 3, h).Value
ElseIf Range(g, h) = Range("H", h) Then
Workbooks("Поиск.xlsm").Range("B" & i).Value = Workbooks(f).Range(g - 4, h).Value
Workbooks("Поиск.xlsm").Range("C" & i).Value = Workbooks(f).Range(g + 1, h).Value
Workbooks("Поиск.xlsm").Range("D" & i).Value = Workbooks(f).Range(g + 4, h).Value
Workbooks("Поиск.xlsm").Range("E" & i).Value = Workbooks(f).Range(g + 3, h).Value
End If
Next i
End If
Set Rng = .FindNext(Rng) 'ищем следующую ячейку на листе
Loop Until firstAddress = Rng.Address 'повторяем цикл, пока не вернёмся к первой найденной ячейкt
End If
Ошибка в строке Set Rng = .FindNext(Rng) 'ищем следующую ячейку на листе надо так
Код
Set Rng = Sht.Cells.FindNext(Rng) 'ищем следующую ячейку на листе
для FindNext - нужно указать где искать. В моём примере код был упакован внутрь
Код
With ActiveSheet.Cells
.....
End With
Раз вы сделали без With ... End with, а просто Set Rng = Sht.Cells.Find, то и для FindNext тоже надо прописывать где искать - Лист.Диапазон ( Set Rng = Sht.Cells.FindNext(Rng) )
вот ваш код, он работает
Код
Sub test2()
Dim Sht As Worksheet, d As String, Rng As Range, firstAddress As String
Set Sht = ActiveSheet
d = "мама"
Set Rng = Sht.Cells.Find(d, , xlFormulas, xlWhole) 'xlWhole - ячейка целиком, xlPart - часть ячейки
If Not Rng Is Nothing Then 'если нашли
'MsgBox "Найдено на листе " & Rng.Parent.Name & " в ячейке " & Rng.Address(0, 0), vbInformation, "Конец"
firstAddress = Rng.Address 'запоминаем адрес первой найденной ячейки
Do
MsgBox "Найдено на листе " & Rng.Parent.Name & " в ячейке " & Rng.Address(0, 0), vbInformation, "Конец"
Set Rng = Sht.Cells.FindNext(Rng) 'ищем следующую ячейку на листе
Loop Until firstAddress = Rng.Address 'повторяем цикл, пока не вернёмся к первой найденной ячейкt
End If
End Sub