Макрос: заполнить столбик до конца заполненной таблицы

[Екатерина Максимова]

Объясняю более подробно. Есть таблица, в которой я сделала дополнительный столбик. В этот столбик я подтягиваю ВПР. Но так как в таблице постоянно меняется количество строчек, то мой макрос сейчас то не до конца протягивает функцию, то наоборот - выходит за пределы таблицы. Можно ли как-то универсально прописать чтобы выделяло до конца заполненной таблицы таблицы(по аналогии с клавишами Ctrl+Shift+стрелочка вниз)? Сильно не ругать - VBA только изучаю.

[cheshiki1]

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

Dim lLastRow As Long
lLastRow = Cells(Rows.Count,1).End(xlUp).Row 'номер последней заполненной ячейки в первом столбце.
подходит?

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

Range("A2:A" & lLastRow).Select

[vikttur]

Если применяете VBA, то и результат вместо ВПР можно получать в коде.

[Екатерина Максимова]

cheshiki1 ,спасибо но не работает :(возможно я как-то не так его ставлю
vikttur, я это знаю, но опять возникает вопрос - как ВПР вставить в ячейки в границах заполненной таблицы?

Если поможет, то код(та часть что отвечает за впр) у меня сейчас выглядит так:
Sheets("1").Select
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],ÂÏÐ!C[-2]:C[-1],2,0)"
    Selection.AutoFill Destination:=Range("C2:C5107")
    Range("C2:C5107").Select
    Range("C2").Select
    Selection.Copy

[vikttur]

Я Вам предложил вообще не использовать функцию листа.
Файл-пример?

[Екатерина Максимова]

Пример во вложении

[vikttur]

Откуда-куда?

[Екатерина Максимова]

Формула ВПР вставляется в столбик С и до конца заполненной таблицы.
ВПР: (А2,ВПР!А:В,2,0)

[vikttur]

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

Sub RetrievalOfData()
Dim ArrData(), ArrInit()
Dim lRws As Long, lRwsIn As Long
Dim i As Long, k As Long
    With Worksheets("ВПР")
        lRwsIn = .Cells(.Rows.Count, 1).End(xlUp).Row ' строк в таблице сравнения
        If lRwsIn < 2 Then Exit Sub ' нет данных, выход
        ArrInit = .Range("A1:B" & lRwsIn).Value ' таблица сравнения в массив
    End With
   
    With Worksheets("Просроки ОИВ")
        lRws = .Cells(.Rows.Count, 1).End(xlUp).Row ' строк в данных
        If lRws < 2 Then Exit Sub ' нет данных, выход
        ArrData = .Range("A1:B" & lRws).Value ' данные в массив
        ReDim Preserve ArrData(1 To lRws, 1 To 3) ' добавляем столбец для результата поиска
        ArrData(1, 3) = .Cells(1, 3).Value
    End With

    For i = 2 To lRws ' построчно проходим по данным
        For k = 2 To lRwsIn ' построчно проходим по таблице сравнения
            If ArrData(i, 1) = ArrInit(k, 1) Then ' искомое совпало
                ArrData(i, 3) = ArrInit(k, 2) ' записываем результат
                Exit For ' выходим (нет смысла просматривать таблицу)
            End If
        Next k
    Next i
   
    ' выгружаем данные на лист, отключив обновление экрана
    Application.ScreenUpdating = False
    Worksheets("Просроки ОИВ").Cells(1, 1).Resize(lRws, 3).Value = ArrData
    Application.ScreenUpdating = True
End Sub

[Екатерина Максимова]

Спасибо, работает. А если вкладок в документе несколько?Формула и состав таблиц один и тот же-меняется только название вкладок...когда подставляю этот код мне уже на второй вкладке выдает ошибку в Dim ArrData(), ArrInit().

[vikttur]

Макрос должен находиться в общем модуле (см. файл в предыдущем моем сообщении). Этому коду безразлично, с какого листа его запускать. Имена листов указаны в макросе.

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

With Worksheets("имялиста")
.........
End With
Все, что внутри оператора и начинается точкой, относится к родителю, указанному в операторе.

Если нужно перебрать все листы одним заходом, можно дополнить макрос:

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

Dim shts As Worksheet
    For Each shts In ThisWorkbook.Worksheets
        If shts.Name <> "ВПР" Then ' если лист с другим именем
            ' то поизвести действия для этого листа
        End If
    Next shts
Но это уже вопрос, выходящий за рамки темы.

[Екатерина Максимова]

Спасибо