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 должен работать, но у меня не получается.
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
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
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
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.