Страницы: 1
RSS
Как заставить макрос выполнять указанное действие столько раз, сколько раз искомое слово встречается на листе
 
      Здравствуйте.
     У меня есть макрос, который ищет в других файлах (всё прописано и работает) указанное слово (через Inputbox)  и найдя его в книге, откуда он был запущен, записывает значения соседних ячеек (соседних с ячейкой книги в которой он нашёл заданное слово). Поиск осуществляется так:
Код
Set Rng = Sht.Cells.Find(d, , xlFormulas, xlWhole)
, где d - это слово, введённое в Inputbox. Проблема в том, что заданное слово может встречаться несколько раз на листе, но макрос обрабатывает только первое нахождение (записывает нужные мне значения соседних ячеек), и дальше идёт искать в другой книге. Как заставить его обработать все нахождения указанного слова на листе?
 
Изменено: Неопытный_Экселист - 25.06.2021 16:55:12
 
Здравствуйте. В примерах снизу ответ - FindNext
Изменено: vladjuha - 25.06.2021 17:04:23
 
Цитата
Как заставить его обработать все нахождения указанного слова на листе?
Используйте FindNext
 
Цитата
Kuzmich написал:
Используйте FindNext
Вместо Find? Или как?  
 
Дополнительно
 
Посмотрите справку по FindNext
 
vladjuha,
Как?
Я плохо понимаю. Приведите пример синтаксиса, пожалуйста.
 
Неопытный_Экселист,
А вы приведите пример
 
Надо почитать комментарии в коде ниже
Код
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
Изменено: New - 25.06.2021 17:48:49
 
Цитата
New написал:
Set Rng = .FindNext(Rng)
На этой строке выбивает ошибку: "Method or data member not found" . Эксель 2016
Изменено: Неопытный_Экселист - 25.06.2021 17:27:03
 
Неопытный_Экселист, прочтите сообщение от Kuzmich выше
 
New,
А без примера никак?
Вот код:

Код
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
Изменено: Неопытный_Экселист - 25.06.2021 17:37:24
 
Ошибка в строке
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
Изменено: New - 25.06.2021 17:58:59
 
Неопытный_Экселист,
Цитата
For i = 1 To Rng
Тип i видимо Long
а Rng - Range
Без примера еще долго будем гадать
 
Цитата
Kuzmich написал:
Без примера еще долго будем гадать
Не будим.
New в посте 13 оказался прав.
New,
Большущее спасибо. Код заработал.  :)  
Изменено: Неопытный_Экселист - 25.06.2021 17:49:25
Страницы: 1
Наверх