Вопрос по использованию циклов и индексации листов и ячеек.

[Zigizman]

Добрый день.

Я только начинаю изучать Exel и сейчас столкнулся со следующим вопросом. Есть книга с двумя листами. На одном листе идут массивы данных, перед каждым массивом в столбце A записан его уникальный идентификатор. На втором список идентификаторов. Мне нужно, что бы на второй лист из каждого массива копировалось последнее значение в столбце K и заносилось на второй лист, в соответствии с идентификатором. Значения предпоследней ячейки для всех массивов одинаковы.
Как можно это реализовать в VBA?
Заранее спасибо за помощь.

[Zigizman]

Если на псевдо коде то должно быть примерно так берем значение из столбца A1 лист 2 ищем его в столбце А листа 1 заоминаем номер строки в переменную i далее идем по столбцу K от позиции i пока не найдем ключевое слово одинаковое для всех ячеек идущих перед нужными копируем текущее значение i+1 и копируем столбец k позиция i+1 на лист2 напротиф идентификатора через столбец от него. Берем следующий и так пока не встретим пустую ячейку на листе 2 столбец A но как это сделать в VBA и какими циклами я не очень понимаю.

[Hugo121]

Вы пример в файле приложите - тогда можно написать конкретный код.
Имхо, тут возможно можно использовать CurrentRegion, но надо видеть файл.

[Zigizman]

Пример таблицы, реально там порядка 10000 строк

[Hugo121]

Я как-то всё больше на массивах...

Sub tt()
    Dim a(), ra As Range, cc As Range, i As Long, x As Long, iFind As Boolean
    
    'диапазон критериев
    Set ra = Sheets(2).Range("A1", Sheets(2).Range("A" & Rows.Count).End(IIf(Len(Sheets(2).Range("A" & Rows.Count)), xlDown, xlUp)))
    x = 1
    'диапазон поиска - в массив
    a = Sheets(1).Range("A1", Sheets(1).Range("K" & Rows.Count).End(IIf(Len(Sheets(1).Range("K" & Rows.Count)), xlDown, xlUp))).Value

'перебор критериев
    For Each cc In ra
    'цикл по массиву, для экономии продолжаем с места предыдущего результата
        For i = x To UBound(a)
        'если нашли критерий, разрешаем искать число
            If InStr(a(i, 1), "Текст: " & cc.Value) > 0 Then iFind = True
            'если таможня дала добро, то
            If iFind Then
                If a(i, 11) = "Всегда  одинаково" Then cc.Offset(, 2) = a(i + 1, 11): iFind = False: x = i: Exit For
            End If
        Next
    Next

End Sub

[nilem]

Похоже Find не работает с объединенными ячейками (это действительно так?). Если можно отказаться от объединенных, то вот вариант (не массивы):

Sub ert()
Dim poz As Range, rng As Range, fr As Range
Application.ScreenUpdating = False
With Sheets("Лист1")
    Set rng = Range(.[a1], .Cells(Rows.Count, 1).End(xlUp))
End With 'активный лист Лист2
For Each poz In Range([a1], Cells(Rows.Count, 1).End(xlUp))
    Set fr = rng.Find(poz)
    If Not fr Is Nothing Then poz(, 3).Value = fr(12, 11).Value
Next
End Sub

[Zigizman]

Всем огромное спасибо за помощь. Завтра протестирую обезательно отпишусь.