Добрый день! Необходимо создать макрос, который будет при выборе холдинга с 10 организациями оставлять 10 строчек и удалять лишние по указанной формуле и наоборот, если 100 организаций - создавать новые и туда вставлять данные по формуле. Заранее спасибо
Добрый день! Необходимо создать макрос, который будет при выборе холдинга с 10 организациями оставлять 10 строчек и удалять лишние по указанной формуле и наоборот, если 100 организаций - создавать новые и туда вставлять данные по формуле. Заранее спасибоMaryasha
Maryasha, а нужно именно удалять или добавлять? почему нельзя сделать изначально таблицу с запасом (строк 200), а потом просто фильтром скрывать пустые?
Maryasha, а нужно именно удалять или добавлять? почему нельзя сделать изначально таблицу с запасом (строк 200), а потом просто фильтром скрывать пустые?buchlotnik
buchlotnik, можно, конечно, но это на 1 действие больше, при условии большого количества таблиц, времени уйдет больше + данные будут подтягиваться в печатную форму отчета, то есть фильтры надо включать/убирать.
buchlotnik, можно, конечно, но это на 1 действие больше, при условии большого количества таблиц, времени уйдет больше + данные будут подтягиваться в печатную форму отчета, то есть фильтры надо включать/убирать.Maryasha
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) <> "G2" Then Exit Sub Application.ScreenUpdating = 0 Application.Calculation = xlCalculationManual n_ = Range("H2") If n_ Then r1_ = Range("B" & Rows.Count).End(3).Row ListObjects("Таблица1").Resize Range("B2:E3") If r1_ > 3 Then Range("B4:E" & r1_).Clear End If If n_ > 1 Then ListObjects("Таблица1").Resize Range("B2:E" & n_ + 2) End If End If Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = 1 End Sub
[/vba]
Так нужно? [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) <> "G2" Then Exit Sub Application.ScreenUpdating = 0 Application.Calculation = xlCalculationManual n_ = Range("H2") If n_ Then r1_ = Range("B" & Rows.Count).End(3).Row ListObjects("Таблица1").Resize Range("B2:E3") If r1_ > 3 Then Range("B4:E" & r1_).Clear End If If n_ > 1 Then ListObjects("Таблица1").Resize Range("B2:E" & n_ + 2) End If End If Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = 1 End Sub
_Boroda_, добрый день! Спасибо.Только тапками не кидайте. А реально ли сделать не удаление строк, а удаление данных в них и формата? Внизу каждой такой таблицы идет вывод и если удалить строки - вывод либо удалится, либо сдвинется. а надо чтобы он остался на месте, тк форма - печатная (образец во вложении)
_Boroda_, добрый день! Спасибо.Только тапками не кидайте. А реально ли сделать не удаление строк, а удаление данных в них и формата? Внизу каждой такой таблицы идет вывод и если удалить строки - вывод либо удалится, либо сдвинется. а надо чтобы он остался на месте, тк форма - печатная (образец во вложении)Maryasha
да сделайте уже таблицу с запасом и фильтруйте автоматом [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$H$3" Then ActiveSheet.ListObjects("Таблица1").Range.AutoFilter Field:=1 ActiveSheet.ListObjects("Таблица1").Range.AutoFilter Field:=1, Criteria1:="<>" End If End Sub
[/vba]
Цитата
а удаление данных в них и формата?
да сделайте уже таблицу с запасом и фильтруйте автоматом [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$H$3" Then ActiveSheet.ListObjects("Таблица1").Range.AutoFilter Field:=1 ActiveSheet.ListObjects("Таблица1").Range.AutoFilter Field:=1, Criteria1:="<>" End If End Sub
_Boroda_, единственное, в таблице с которой работаем, холдинги не фигурируют (в названиях столбцов их нет), то есть формула в H2 будет немного другая, тк останутся только коды и организации
_Boroda_, единственное, в таблице с которой работаем, холдинги не фигурируют (в названиях столбцов их нет), то есть формула в H2 будет немного другая, тк останутся только коды и организацииMaryasha