Поиск по всем листам другой книги

[10Dmitriy10]

Добрый день!

Не получается настроить поиск по листам другого документа... если лист будет активен, то найдет..,
А если таких листов больше 30 и нужный не активен, то как быть?

Заранее спасибо!

Код (vb) Выделить Развернуть

Sub Poisk()
Dim x As Variant
Dim WS_Count As Integer
Dim I As Integer

   Windows("PoiskPoListam.xlsm").Activate
   x = Application.Range("B2").Value
   Windows("3.xlsx").Activate
   WS_Count = ActiveWorkbook.Sheets.Count
For I = 1 To WS_Count
   Cells.Find(What:=x, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext).Select
   ActiveCell.Offset(0, -3).Select
   Selection.Copy
Next I
   
Windows("PoiskPoListam.xlsm").Activate
Range("B3").Select
ActiveSheet.Paste
End Sub

[vikttur]

Что нужно? Перебор всех неактивных листов?

[10Dmitriy10]

А как обратиться к другой книге не активируя ее? Funktiom?

Нужно подправить код чтобы работал.. выбивает ошибку при поиске, если лист и "искомым" значением не активен. Проблема в цикле или в описании поиска?

[vikttur]

Не получается настроить поиск по листам другого документа..
как обратиться к другой книге не активируя ее?

Вам хлеба или масла? Тема о чем?

[10Dmitriy10]

Перебор всех листов другой книги, включая активный ( если искомое значение там ).

[Дмитрий Щербаков(The_Prist)]

Для начала сюда: Select и Activate - зачем нужны и нужны ли?
Далее не помешает ознакомиться со ссылками внизу страницы.

[kuklp]

10Dmitriy10, Я Вам показывал как искать не активируя лист, но Вы снова загадили код макрорекордерным мусором, а в ответ на мое замечание ответили, что Вам так удобней. Хотите чтоб Вам и дальше помогали?

[10Dmitriy10]

The_Prist, спасибо! Прочитал. Сейчас буду исправлять код)

Kuklp, сейчас подправлю код. И постараюсь все закинуть в модуль листа.

[10Dmitriy10]

Код (vb) Выделить Развернуть


Sub Poisk()  
Dim x As Variant  
Dim WS_Count As Integer  
Dim I As Integer  

x = Cells(2,2) .Value  
WS_Count = Application.Workbooks("3.xlsx").Sheets.Count  
For I = 1 To WS_Count  
Cells.Find(What:=x, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext).Value
ActiveCell.Offset(0, -3).Copy
Next I  
Worbook("PoiskPoListam.xlsm").Sherts(1).Range("B3").Paste

End Sub  



Как-то так. Подправил в заметках телефона, поэтому не уверен что без ошибок)

[sboy]

Дмитрий, главная ошибка, что искали в той же книге...
Если Вы запускаете макрос из книги "PoiskPoListam.xlsm", то вот так можно

Код (vb) Выделить Развернуть

Sub Poisk()
Dim x As Variant
Dim WS As Workbook
Dim I As Integer
Dim rFind As Range
 
x = Cells(2, 2).Value
Set WS = Application.Workbooks("3.xlsx")
For I = 1 To WS.Sheets.Count
    Set rFind = WS.Sheets(I).Cells.Find(What:=x, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
        If Not rFind Is Nothing Then
            Sheets(1).Range("B3").Value = rFind.Offset(0, -3).Value
            Exit For
        End If
Next I
End Sub


[10Dmitriy10]

sboy,

Спасибо! Все шикарно работает!

[10Dmitriy10]

Столкнулся с проблемкой..
ищет, но выдает только первое найденное значение.. как найти следующее при следующем выполнении цикла? FindNext?
Было бы не плохо еще имя листа (на котором нашли) в соседнюю ячейку закинуть..

Поможете?

[sboy]

по вопросу как работает FindNext довольно хорошо написано в справке VBA
а по вашей задаче непонятно, что в итоге получить хотите? что со следующим делать? или вам все совпадения надо найти и вывести? в изначальных условиях задачи ничего об этом не сказано)

[10Dmitriy10]

Сейчас гляну справку) может что из этого выйдет))

нажал на кнопку - нашел диапазон/значение, еще раз нажал - нашел второе совпадение..

Изначально я не знал что значеия могут повторяться на нескольких листах.., поэтому на первом этапе этого было с головой)

[10Dmitriy10]

Видел справку) читал ее и пробовал использовать, но как и говорил, находило только следующее, пропуская предыдущее значение.

Возможно, проблема в том куда выводил найденное или как его вставлял)

[sboy]

Возможно надо понять, что должно получиться в итоге)

[10Dmitriy10]

Тоже самое) Сейчас поиск идет до первого совпадения.

Нужно чтобы выдал второе, (3е, 4е)  после повторного нажатия на кнопку (повтор цикла).

[sboy]

Код (vb) Выделить Развернуть

Sub Poisk_CNum()

Dim x As Variant
Dim WB As Workbook
Dim i As Integer
Dim rFind As Range
    x = Cells(2, 2).Value
    Set WB = Application.Workbooks("1.xlsx")
    For i = 1 To WB.Sheets.Count
        With WB.Sheets(i).Cells
        Set rFind = .Find(What:=x, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
            If Not rFind Is Nothing Then
                Sheets(1).Range("B7").Value = rFind.Offset(0, -3).Value
                Sheets(1).Range("C7").Value = rFind.Offset(0, -2).Value
                firstAddress = rFind.Address
                    Do
                        MsgBox "Нашел на листе " & WB.Sheets(i).Name & rFind.Address
                        Set rFind = .FindNext(rFind)
                    Loop While Not rFind Is Nothing And rFind.Address <> firstAddress
            End If
        End With
    Next i
End Sub

[10Dmitriy10]

Почти в яблочко)
только:
1) Выводить имя листа в Ячейку А7  

Код (vb) Выделить Развернуть

Cells (7,2) = WB.Sheets(i).Name
Но в таком виде как-то дальше не идет поиск
2) Цикл сейчас "не отпускает", т.е пролистываю значения нажатием кноаки "Ок" в  MsgBox, но остановиться на нужном не могу.

Нужно найти, выдать информацию и выйти из цикла. Следующий клик - найти второе и т.д)

[10Dmitriy10]

Cells (7,1) = WB.Sheets(i).Name   

[sboy]

Почти в яблочко)

я с Вами в бабу Вангу играть не собираюсь...
перечитайте посты №12 и №15

[10Dmitriy10]

Исправлюсь)
Вот в таком виде работает почти как надо.

Код (vb) Выделить Развернуть


Sub Poisk_CNum()
Dim x As Variant
Dim WB As Workbook
Dim i As Integer
Dim rFind As Range
x = Cells(2, 2).Value
Set WB = Application.Workbooks("1.xlsx")
For i = 1 To WB.Sheets.Count
With WB.Sheets(i).Cells
Set rFind = .Find(What:=x, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
If Not rFind Is Nothing Then
firstAddress = rFind.Address
Do
MsgBox "Naschel na  " & WB.Sheets(i).Name
'& rFind.Address
Set rFind = .FindNext(rFind)
Sheets(1).Range("B7").Value = rFind.Offset(0, -3).Value
Sheets(1).Range("C7").Value = rFind.Offset(0, -2).Value
Sheets(1).Range("A7").Value = WB.Sheets(i).Name
Loop While Not rFind Is Nothing And rFind.Address <> firstAddress
End If
End With
Next i
End Sub

Только не работает без MsgBox..    Да и с ним я не могу остановиться на нужном найденном значении.. могу только просмотреть все.

[10Dmitriy10]

Рабочий код. Если кому надо.

Код (vb) Выделить Развернуть


Sub Poisk_CNum()
    Dim x As Variant
    Dim f As Boolean
        Dim WB As Workbook
    Dim i As Integer
    Dim rFind As Range
    x = Cells(2, 2).Value
    Set WB = Application.Workbooks("1.xlsx")
        For i = 1 To WB.Sheets.Count
            With WB.Sheets(i).Cells
                Set rFind = .Find(What:=x, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
                If Not rFind Is Nothing Then
                    firstAddress = rFind.Address
                    Do
                    'MsgBox "Naschel na  " & WB.Sheets(i).Name
                    '& rFind.Address
                        If MsgBox("Naschel na  " & WB.Sheets(i).Name, vbYesNo, "Confirm") = vbYes Then
                            Set rFind = .FindNext(rFind)
                            Sheets(1).Range("A7").Value = WB.Sheets(i).Name
                            Sheets(1).Range("B7").Value = rFind.Offset(0, -3).Value
                            Sheets(1).Range("C7").Value = rFind.Offset(0, -2).Value
                        End If
                        If MsgBox("Naschel na  " & WB.Sheets(i).Name, vbYesNo, "Confirm") = vbNo Then
                            f = True
                        End If
                            If f Then
                                 Exit For
                            End If
                Loop While Not rFind Is Nothing And rFind.Address <> firstAddress
                End If
            End With
        Next i
End Sub