Страницы: 1
RSS
Макрос на отображение только заполненных таблиц на листе.
 
Добрый день Уважаемые форумчане!

Прошу, помогите пожалуйста написать макрос для листа "группы" который будет отображать только группы в которых фигурирует хотя-бы один человек. Что то типа действия "скрыть" только не для столбцов или строк, а для конкретных границ таблицы, и так чтобы это все совместно стояло а не в разброс для их удобного просмотра пользователями и для того чтобы на А4 пользователям печатать можно было без лишних действий.
 
Доброе время суток
Цитата
Stounv17 написал:
помогите пожалуйста написать макрос
А чем помочь - у вас ни строчки кода.
Цитата
Stounv17 написал:
стояло а не в разброс для их удобного просмотра пользователями и для того чтобы на А4 пользователям печатать можно было без лишних действий.
Так приведите ручной пример такого варианта заполнения и результата скрытия. А то в имени файла вы много букв а смогли написать, так почему бы не помочь хоть чем-нибудь тому, кто будет делать для вас макрос, предоставив ему пример для тестирования? :)
 
Цитата
Андрей VG написал:
приведите ручной пример такого варианта заполнения и результата скрытия.
И именно пример, а не огромный рабочий файл.
 
Андрей VG, здравствуйте!

Не владею макросом, прошу помощи!

Не знаю можно ли на том-же листе сделать макросом так чтобы таблицы без каких-либо фамилий скрывались, полагаю что все-таки нет. Тогда может быть получится сделать вариант чтобы заполненные таблички попадали на другой лист друг за другом максимум 2 таблицы в строчке? думаю что такой вариант можно сделать, но как это прописать в макросе я совсем не знаю.Есть еще один вариант, это чтобы таблицы сами друг за другом формировались когда на листе база учеников, ученик закрепляется за новой группой. Думаю что последний вариант самый удобный.

Юрий М, ок! Прикрепляю файл только с листом где формируются таблицы на базе данных с другого листа который я удалил.
Изменено: Stounv17 - 12.09.2019 15:28:35
 
Цитата
Stounv17 написал:
чтобы заполненные таблички попадали на другой лист друг за другом максимум 2 таблицы в строчке
Заполненной считается таблица, в которой есть хотя бы один ученик?
 
Юрий М, так точно товарищ модератор!
 
Есть небольшая проблема: у Вас разное количество строк между группами. Можете сделать одинаковым? Это немного упростит и ускорит макрос.
 
См. вариант.
 
Юрий М, Все хорошо, но дело в том, что когда меня попросили сделать пример а не скидывать большой рабочий файл, я поудалял другие листы, а на листе группы в столбцах ФИО и Контакты были формулы, которые подтягивали значения с БАЗЫ_УЧЕНИКОВ, которые пришлось заменить на значения иначе во всех ячейках было бы сообщение об ошибке!

т.е. сейчас получается, когда я интегрировал этот макрос в свой рабочий файл он мне перетягивает на этот лист все таблицы хотя бы с одним учеником, НО копирует ячейки вместе с формулами и получается что изменив свое месторасположение они уже не работают и ячейки с ФИО и контактами пустые. Нужно сделать так чтобы копировал и вставлял форматы и значения. Формулы не копировал. Можно так сделать? Чтобы не лезть в пример, привожу в сообщении код.
Код
Sub Кнопка_группы()
Dim LastRow As Long, j As Long, FreeRow As Long, FreeColumn As Long, LastColumn As Long
    Application.ScreenUpdating = False
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Range(Cells(4, 2), Cells(LastRow, 8)).Clear
    FreeRow = 6
    FreeColumn = 2
    With Sheets("Группы")
        LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
        LastColumn = .Cells(6, Columns.Count).End(xlToLeft).Column
        For i = 6 To LastRow ' Step 27
            If .Cells(i, 2) = 1 Then
                For j = 2 To LastColumn Step 4
                    If .Cells(i, j + 1) <> "" Then
                        Range(.Cells(i - 3, j), .Cells(i + 17, j + 2)).Copy Cells(FreeRow, FreeColumn)
                        FreeColumn = FreeColumn + 4
                        If FreeColumn > 6 Then
                            FreeColumn = 2
                            FreeRow = FreeRow + 22
                        End If
                    End If
                Next
            End If
        Next
    End With
    
    Application.ScreenUpdating = True
End Sub
Изменено: Stounv17 - 13.09.2019 16:40:58
 
Stounv17,   Замените строку
Код
Range(.Cells(i - 3, j), .Cells(i + 17, j + 2)).Copy Cells(FreeRow, FreeColumn)
на
Код
Range(.Cells(i - 3, j), .Cells(i + 17, j + 2)).Copy
Cells(FreeRow, FreeColumn).PasteSpecial Paste:=xlPasteValues
 Cells(FreeRow, FreeColumn).PasteSpecial Paste:=xlPasteFormats
 
casag,Большое спасибо, все работает как надо! Класс
 
casag, Еще такой вопрос!
А можно в коде прописать чтобы пустые строчки предназначенные под фамилии и контактные данные не копировал? Чтоб лишнего не печатать и природу беречь!=)
 
Вставьте ПЕРЕД строкой
Код
Application.ScreenUpdating = True
следующий код

Код
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
For i = LastRow To 9 Step -1
    If Not Cells(i, 3).MergeCells And Cells(i, 3) = "" And Cells(i, 2) <> "" And Cells(i, 7) = "" Then
        Rows(i).Delete
    End If
 Next

или  сделайте как в файле.В файле изменил форматирование листа "Группы"

выбирайте какой вариант вам больше нравится

Изменено: casag - 16.09.2019 23:04:02
 
casag,  8-0

СПАСИБО БОЛЬШОЕ!!!!! Тож хочу так научиться шКОДИТЬ по любому поводу =))))

;)  
Страницы: 1
Наверх