Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
VBA. Автозаполнение формулами по отфильтрованному списку сразу нескольких столбцов.
 
#1
06.07.2020 13:50:44

Здравствуйте, есть проблема по автопротягиванию формулы в отфильтрованном списке. Проблема в том что список получается длинный, иногда до 10к строк тянуть приходится больше минуты. Пытаюсь решить это макросом но получилось только частично. приведенный ниже макрос работает только по одному столбцу - быстро, точно и без нареканий, и если запускать по несколько раз получается быстрее чем протяжка сразу нескольких столбцов. Но хотелось бы его улучшить и заставить его как-то работать на диапазоне в несколько столбцов.

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

Данный код по работе с одним столбцом и он работает.

Код
Private Sub UFoAutoFill()

Dim Col1 as string, col99 as string, _
Row1 as long, Row99 as long

Col1 = UserformCol1.Value           'A, B, C, AA, AB, AC & etc
Col99 = UserformCol99.Value       'A, B, C, AA, AB, AC & etc
Row1 = UserformRow1.Value        ' 1, 2, 100 & etc
Row99 = UserformRow99.Value        ' 1, 2, 100 & etc

Range(Col1 & Row1 & ":" & Col1 & Row99).SpecialCells(xlCellTypeVisible).FormulaR1C1 = Range(Col1 & Row1).FormulaR1C1     'заполнение по одному столбцу

Unload Userform
End sub

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

Код
Range(Col1 & Row1 & ":" & Col99 & Row99).SpecialCells(xlCellTypeVisible).FormulaR1C1 = Range(Col1 & Row1 & ":" & Col99 & Row99 ).FormulaR1C1    

Подскажите, что можно предпринять ? Может быть цикл, который каждый столбец будет заполнять на основании первой ячейки столбца? (циклы пока даются очень тяжело  :) )

На всякий случай кусочки кода без переменных. (Range("A10:K10") - содержит формулы которые нужно протянуть.)
Код
Range("A10:A1000").SpecialCells(xlCellTypeVisible).FormulaR1C1 = Range("A10").FormulaR1C1      'это работает
Код
Range("A10:K1000").SpecialCells(xlCellTypeVisible).FormulaR1C1 = Range("A10:K10").FormulaR1C1  ' "это не работает(точнее работает но не так как хотелось)
Изменено: kgaydm - 06.07.2020 17:26:44
 
 
 
#2
06.07.2020 14:05:20
kgaydm, дд. лучше бы приложили файл пример и показали исходные данные и что должно получится на выходе.
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
06.07.2020 15:23:12
Табличка пример
 
 
 
#4
06.07.2020 16:06:37
kgaydm, обязательно макрос  ? можно же просто выделить диапазон и двойным нажатием кнопки по правому нижнему углу и все.
Изменено: Mershik - 06.07.2020 16:19:55
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#5
06.07.2020 16:56:42
К сожалению нельзя так просто взять и нажать - это не работает, я внес корректировки в файл примера. Попробуйте еще раз ваш метод  ;)  
 
 
 
#6
06.07.2020 17:06:49
kgaydm, мой вам совет сделать файл-пример как требует того правила не более 300 Кб и исходные данные и рядом желаемый результат (достаточно 10 - 20 строк) с этими нюансами что по дороге может уже быть что-то заполнено  и что с этим делать показать..
модераторы придут и закроют тему (если нормальный пример не приложите) ИМХО.
а так навскидку при копировании  вроде вставляется по умолчанию в видимые, я сделал (на картинке видно) в первой строке формулы (они же я как я понял одинаковые для всех строк)  а уже потом вставляем
Код
Sub Макрос1()
Dim rng As Range
Dim lr As Long
Set rng = Application.InputBox("Выберите диапазон с формулами (должны идти без разрывов) ", Type:=8)
    rng.Copy
    lr = Cells(Rows.Count, 2).End(xlUp).Row
    Range("D7:F" & lr).Select
    ActiveSheet.Paste
End Sub
Изменено: Mershik - 06.07.2020 17:27:33
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#7
06.07.2020 17:26:20
Хотите мини, пожалуйста. Просто все это пошло по линии VBA именно потому что количество строк не маленькое. Если протяжка занимает минуту, то в зависимости от загруженности файлов (они сетевые и там могут работать несколько человек), пересчет формул может занять до 3-4 минут. VBA делает один столбец максимум за 15 секунд при любой погоде.
Увидел картинки, не пойму что выделить и почему у вас фильтр не на том столбце ?
 
 
 
#8
06.07.2020 17:32:50
kgaydm, я выше уже показал вам...но могу еще
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#9
06.07.2020 17:50:32
Круто! Спасибо.

Разрешите маленькую ремарку  :) . Чуть чуть укоротил ваш код. может кому пригодится.
Код
Sub FFF()
Dim lr As Long

    lr = Cells(Rows.Count, 2).End(xlUp).Row
    Range("D7:F7").Copy Range("D7:F" & lr)
    
End Sub

Еще раз благодарю  :D !
 
 
 
#10
07.07.2020 17:38:33
Если кому понадобится, придумал еще одно решение через цикл:

Код
Sub MultiFill

Dim TheCell as range

For Each TheCell In Range ("A11:K1000").SpecialCells(xlCellTypeVisible).Cells
TheCell.FormulaR1C1 = Cells(10, TheCell.Column).FormulaR1C1

End Sub
Изменено: kgaydm - 08.07.2020 19:39:31
 
 
 
Страницы: 1
Наверх