Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Поиск всех значений (не только первое совпадение) в цикле
 
#1
17.12.2021 08:16:36
Всем привет! :)
Прошу помощи.

Есть вот такой код:
Код
Sub trytryrty()  
  
For i = 1 To ThisWorkbook.Sheets("Constructor").Cells(Rows.Count, 3).End(xlUp).Row  
    For j = 1 To ThisWorkbook.Sheets.Count  
        If ThisWorkbook.Sheets("Constructor").Cells(i, 3).Value = Sheets(j).Name Then  
            ThisWorkbook.Sheets("Constructor").Range(Cells(i, 3).Offset(1, 20), Cells(i, 3).Offset(1, 36)).Copy  
            Set aaa = ThisWorkbook.Sheets("Constructor").Cells(i, 3).Offset(0, -1)  
            Set bbb = ThisWorkbook.Sheets(j).Range("AH1:AI1000").Find(aaa, , xlValues, xlWhole).Offset(0, -30)  
            Set ccc = ThisWorkbook.Sheets(j).Columns(bbb.Column).Find("18", , xlValues, xlWhole).Offset(0, 2)  
        End If  
    Next  
Next  
  
End Sub  

Подскажите, пожалуйста, как мне сделать поиск ВСЕХ значений, указанных здесь:
Код
Set ccc = ThisWorkbook.Sheets(j).Columns(bbb.Column).Find("18", , xlValues, xlWhole).Offset(0, 2)

Find ищет только первое вхождение, а мне нужно, чтобы нашёл каждое. По идее .FindNext должен работать, но у меня не получается.

Может быть есть у кого светлые идеи? :)
Изменено: vikttur - 21.12.2021 12:36:04
 
 
 
#2
17.12.2021 08:31:53
Про FindNext не знаю, знаю что Find находит первое вхождение, определяем и запоминаем найденную строку и дальше ищем со следующей строки.  
Изменено: _Igor_61 - 17.12.2021 08:33:14
 
 
 
#3
17.12.2021 08:33:01
Код
Function FindAll(ShNm$, Fnd, Optional Rng As Range = Nothing) As Range
  Dim rg As Range, frg As Range, adr$
  If Rng Is Nothing Then Set Rng = Worksheets(ShNm).Cells
  Set rg = Rng.Find(Fnd, , xlValues, xlWhole, Searchformat:=False)
  If rg Is Nothing Then Exit Function Else adr = rg.Address: Set frg = rg
  Do
    Set rg = rgn.Find(Fnd, rg)
    If rg.Address = adr Then Exit Function Else Set frg = Union(frg, rg)
  Loop
  Set FindAll = frg
End Function
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#4
17.12.2021 08:33:46
_Igor_61, то есть несколько find?
 
 
 
#5
17.12.2021 08:40:41
Цитата
Breathe of fate написал:
то есть несколько find?
то есть открываем документацию и берем от туда пример.
По вопросам из тем форума, личку не читаю.
 
 
 
#6
17.12.2021 08:42:33
Breathe of fate, Find один, но кроме него существуют циклы
 
 
 
#7
17.12.2021 09:16:58
Breathe of fate Есть метод Find и метод FindNext Вот пример с этими методами, а справку все равно надо читать
Код
Sub FindRange() ' Поиск всех ячеек на активном листе
Dim Rg1 As Range, Rg2 As Range, FindText$, Adres$
FindText = "винт" ' ищем ячейки с текстом содержащим винт
    Set Rg1 = ActiveSheet.UsedRange
    
    Set Rg2 = Rg1.Find(FindText, , xlValues, xlPart) 'Краткая запись для поиска
If Not Rg2 Is Nothing Then 'After можно не указывать
        Adres$ = Rg2.Address
        Do
         MsgBox Rg2.Address ' Здесь будут все найденные ячейки
            Set Rg2 = Rg1.Cells.FindNext(After:=Rg2)
        Loop Until Rg2.Address = Adres
End If
End Sub
 
 
 
#8
17.12.2021 20:17:05
Breathe of fate,
в сообщении 3 написана функция, которая найдет ВСЕ
что в ней вас не устраивает?
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#9
21.12.2021 11:50:58
Я не понял, как ей пользоваться и что и куда вводить

Цитата
_Igor_61 написал:
нужно, и результат выводим куда нужно
спасибо. Сделал по-другому немного, но ищу по диапазонам, всё работает.
 
 
 
#10
06.02.2024 22:06:02
Попробуйте так
Код
Sub search()

Dim rg_main As Range
Dim rg As Range
Dim coll As New Collection

'произвольная ячейка
Set rg = Range("A10")
'Ваш диапазон
Set rg_main = Range("A1:D5")
'искомое значение
search_value = 1

Do
    Set rg = rg_main.Find(search_value)
    If Not rg Is Nothing Then
        coll.Add rg.Address
        Set rg_main = exclude(rg_main, rg)
    End If
Loop While Not rg Is Nothing
 
End Sub

Function exclude(rg_main As Range, rg As Range) As Range
Dim rg1 As Range
Dim rg2 As Range
For Each rg1 In rg_main
    If Intersect(rg1, rg) Is Nothing Then
        If rg2 Is Nothing Then
            Set rg2 = rg1
        Else
            Set rg2 = Union(rg2, rg1)
        End If
    End If
Next rg1
Set exclude = rg2
End Function


Адреса ячеек, в которых содержится Ваше значения, будут собраны в коллекцию coll.
Изменено: Евгений Фёдоров - 06.02.2024 22:06:35
 
 
 
Страницы: 1
Наверх