Поиск, смещение и замена данных

[Обыватель]

Добрый день!

Пытаюсь понять, куда встроить функцию OffSet.

Хотел получить следующий результат: на листе "критерии" есть две колонки - с поисковым образом и со значениями, которые надо заменить (перенести) на всех листах книги (исключая лист с критериями).

Проблема в том, что это не просто замена одного значения на другое, а надо сначала надо найти ячейку, содержащую поисковый образ, потом сместиться на несколько ячеек вправо и произвести перенос в ячейку значения с листа "критерии".

Пока не преуспел в данной задаче.

Подскажите, пожалуйста, как будет правильно.

Спасибо.

[Serge_Bliznykov]

я не мастер, но попробуйте такой код:

Sub FindAndExecute()

Dim Sh As Worksheet
Dim Loc As Range
Dim myList As Range, CriteriaCell As Range, iCritRow As Long
Dim sFirstAddress

iCritRow = Sheets("критерии").Cells(Sheets("критерии").Rows.Count, "A").End(xlUp).Row
Set myList = Sheets("критерии").Range("A2:A" & iCritRow)

For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "критерии" Then
      For Each CriteriaCell In myList
        With Sh.UsedRange
            Set Loc = .Cells.Find(What:=CriteriaCell.Value)
            If Not Loc Is Nothing Then
                sFirstAddress = Loc.Address
                Do
                    Loc.Offset(0, 2).Value = CriteriaCell.Offset(0, 1).Value ' заменить значение
                    Set Loc = .FindNext(Loc) ' продолжить поиск
                Loop While Not Loc Is Nothing And Loc.Address <> sFirstAddress
            End If
        End With
        Set Loc = Nothing
      Next ' конец цикла по критериям
    End If ' конец обработки условия лист <> "критерии"
Next


End Sub

[Обыватель]

Что-то Вы явно поскромничали... работает и очень хорошо работает.
Даже на 80% разобрался в коде.

Благодарю!

[Serge_Bliznykov]

Сообщение от Обыватель

Что-то Вы явно поскромничали... работает и очень хорошо работает.

да работает то оно работает.
Но я уверен, что профи мог бы весь этот код забабахать в пару команд, упразднив пару циклов.

Сообщение от Обыватель

Даже на 80% разобрался в коде.

да, побочный эффект от моей малограмотности - это то, что код легко читается и понимается!
а что скрылось в эти непонятые 20% ?

[Казанский]

Обыватель, откройте для себя функцию ВПР: в ячейке С2 любого листа введите

=ВПР(A2;критерии!A:B;2;)

и автозаполните вниз.
То же самое можно сделать макросом.

[Обыватель]

Сообщение от Казанский

Обыватель, откройте для себя функцию ВПР: в ячейке С2 любого листа введите

=ВПР(A2;критерии!A:B;2;)

и автозаполните вниз.
То же самое можно сделать макросом.

Как раз с формулами у меня проблем нет в любом сочетании, но не все задачи ими решаются.
Проблема была в том, как на 150 листах занести эту формулу в строго определенные ячейки.

С уважением

[Обыватель]

Сообщение от Serge_Bliznykov

да работает то оно работает.
Но я уверен, что профи мог бы весь этот код забабахать в пару команд, упразднив пару циклов.



да, побочный эффект от моей малограмотности - это то, что код легко читается и понимается!
а что скрылось в эти непонятые 20% ?

Главное результат ))

Вот тут я подвис. Просто для меня сложноватый подход.

"Set Loc = .Cells.Find(What:=CriteriaCell.Valu e)
If Not Loc Is Nothing Then
sFirstAddress = Loc.Address
Do
Loc.Offset(0, 2).Value = CriteriaCell.Offset(0, 1).Value"

[Serge_Bliznykov]

Сообщение от Казанский

откройте для себя функцию ВПР

кстати, у меня, когда писал код с циклами поиска и замены, была мысль вместо Value просто вставлять формулу с ВПР()
на мой взгляд - это и есть правильное решение:
1) это можно делать там, где нужно (не привязываясь к смещению)
2) это может делать сам пользователь, менять макрос для этого не надо
3) и, самое главное, получается "живая" связь - если поменять значение на странице "критерии", то автоматически везде поменяется нужное значение в ячейках, где вставлена формула с ВПР()

[Serge_Bliznykov]

Set Loc = .Cells.Find(What:=CriteriaCell.Value) 
в Loc поместили результаты поиска на листе по значению из CriteriaCell.Value 

            If Not Loc Is Nothing Then

если что-то нашлось (результат поиска не равен Nothing ), тогда


                sFirstAddress = Loc.Address
 
Запомним адрес найденной ячейки (поиск так сделан, что если его продолжить 
командой FindNext(Loc), то, дойдя до конца листа, он снова начинает искать опять с начала листа,
и находит опять первую ячейку.
Вот, чтобы избежать зацикливания, запоминаем адрес первой найденной ячейки
и в условиях цикла проверяем, чтобы очередной найденный адрес не был равен адресу первой найденной ячейки
см. условие And Loc.Address <> sFirstAddress

                Do
начать цикл

                    Loc.Offset(0, 2).Value = CriteriaCell.Offset(0, 1).Value

по смещению на два столбца от найденной ячейки записать значение ячейки, 
расположенной на один столбец правее критерия

[Казанский]

Сообщение от Обыватель

как на 150 листах занести эту формулу в строго определенные ячейки

Если листы имеют одинаковую структуру, как в примере, то так

Sub FindAndExecute1()
Dim Sh As Worksheet
  For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "критерии" Then
      With Sh.Range("C2:C" & Sh.Cells(Rows.Count, 1).End(xlUp).Row) 'конец диапазона определяется по первому столбцу
        .Formula = "=VLOOKUP(A2,критерии!A:B,2,)"
        .Value = .Value 'заменить формулы на значения, необязательно
      End With
    End If
  Next
End Sub

Если на разных листах таблица начинается не с А1, можно определить критерий начала таблицы, определить диапазон для вставки формулы и работать с ним.