Страницы: 1
RSS
Макрос на скрытие столбцов по нескольким выпадающим спискам, Создание скрытых столбцов
 
Добрый день
Прошу помочь вот с чем:
Есть книга на кучу столбцов.
Как завязать макрос на выпадающий список?
Чтоб прятались столбцы в зависимости от значения в выпадающем списке
(к примеру:Есть виды рекламы : наружка , тв , радио  ПОМЕСЯЧНО
Есть план факт и сальдо .
К примеру выберем наружку , январь и таблица станет другого вида.

Во вложении пример Было- Стало. и сам файл файлы удалены - превышение допустимого размера вложения [МОДЕРАТОР]
 
Это в модуль листа "План по менеджерам"
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C1:C2")) Is Nothing Then FilterColumn
End Sub
Это вставить в стандартный модуль и запустить один раз.
Код
Sub Макрос1()
    With Range("C1").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="Наружка,Радио,Телевидение,Итого"
        .IgnoreBlank = False: .InCellDropdown = True: .InputTitle = "": .ErrorTitle = "": .InputMessage = "": .ErrorMessage = "": .ShowInput = True: .ShowError = True
        .Parent.Value = "Наружка"
    End With
    With Range("C2").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="Январь,Февраль,Март,Апрель,Май,Июнь,Июль,Август,Сентябрь,Октябрь,Ноябрь,Декабрь"
        .IgnoreBlank = False: .InCellDropdown = True: .InputTitle = "": .ErrorTitle = "": .InputMessage = "": .ErrorMessage = "": .ShowInput = True: .ShowError = True
        .Parent.Value = "Январь"
    End With
End Sub
Это вставить в стандартный модуль.
Код
Sub FilterColumn()
    Dim showColumn As Boolean
    Dim x As Long
    For x = 5 To ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
        showColumn = False
        If Cells(3, x).Value = Range("C2").Value Then
            If InStr(Cells(1, x).MergeArea.Cells(1, 1).Value, Range("C1").Value) > 0 Then
                showColumn = True
            End If
        End If
        Columns(x).Hidden = Not showColumn
    Next
End Sub
Меняйте значения в ячейках C1 и C2.
Изменено: МатросНаЗебре - 13.01.2022 14:33:22
 
Добрый день , спасибо , но вылезает ошибка и выделается вся верхняя строчка желтым  
Изменено: Виталий Чебоатёр - 13.01.2022 14:51:56
 
Вы только один макрос вставили?
 
Да
Пробный файл.xlsm (51.33 КБ)

Цитата
Вы только один макрос вставили?
Точнее сначала два, потом второй запустил и вставил третий . Верно ?
Страницы: 1
Читают тему (гостей: 1)
Наверх