Новости:

К первому сообщению темы должен быть прикреплен файл примера в формате xls*.
Приложив пример, Вы избавите себя и других от вопросов типа "А какой критерий?", "А куда выводить результат?", "А сколько строк?" и все тех же просьб выложить файл. Рисовать за Вас Ваши же таблички с заданиями, а затем и решение к ним, никто желанием не горит. Да и, как показывает практика, в большинстве случаев без файла решения не найти.

Главное меню

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

Автор Екатерина Максимова, 20.09.2016, 16:18

« назад - далее »

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

Объясняю более подробно. Есть таблица, в которой я сделала дополнительный столбик. В этот столбик я подтягиваю ВПР. Но так как в таблице постоянно меняется количество строчек, то мой макрос сейчас то не до конца протягивает функцию, то наоборот - выходит за пределы таблицы. Можно ли как-то универсально прописать чтобы выделяло до конца заполненной таблицы таблицы(по аналогии с клавишами 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

Но это уже вопрос, выходящий за рамки темы.