Маркрос для юзер формы с флажками (для фильтра) - Мир MS Excel

Регистрация

Напомнить пароль

= Мир MS Excel/Маркрос для юзер формы с флажками (для фильтра) - Мир MS Excel

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Маркрос для юзер формы с флажками (для фильтра) (Макросы/Sub)

Маркрос для юзер формы с флажками (для фильтра)

Дата: Суббота, 01.12.2018, 19:54 | Сообщение № 1

Группа: Проверенные

Ранг: Обитатель

Сообщений: 429

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Всем привет. Есть таблица с данными.. большая таблица. Когда в ней приходится что то искать, то в разных столбцах фильтрую по нужным документам и пользуюсь таблицей. Но это не очень удобно и занимает больше времени, чем хотелось бы. Хочу сделать для нескольких столбцов юзерформу (одну), в которой буду ставить флажки, по которым будет включаться фильтры по этим столбцам. Нарисовать форму для меня проблемы нет, а вот с макросами засада. Допустит записал я макрорекодером макрос фильтра по одному документу и "прицепил" его к флажку на юзерформу. Но как сделать, чтобы если я обратно убрал флажок все возвращалось на шаг назад? или как сделать фильтр, если я два флажка поставил? То тогда фильтр по двум документам должен сработать.. файл рабочий выложить не могу. Может достаточно свою задачу расписал..если нет, то сделаю пример.

Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.

Сообщение отредактировал ovechkin1973 - Суббота, 01.12.2018, 19:55

Ответить

Дата: Воскресенье, 02.12.2018, 04:03 | Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 443

Репутация: 26 ±

Замечаний: 0% ±

Excel 2013

Приложите файл пример,что есть и как надо

Ответить

Дата: Воскресенье, 02.12.2018, 09:24 | Сообщение № 3

Группа: Проверенные

Ранг: Обитатель

Сообщений: 429

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

пример сделал. кнопкой буду в реальном файле запускать форму, она будет значительно больше (флажков на ней будет больше). Документов в столбце D в реальном файле больше сотни. Для работы мне нужно фильтровать не более, чем по 15-20 документам. Столько флажков и сделаю. Нужно чтобы фильтр по этим документам включался при включении флажка. Если включил несколько флажков, то соответственно по этим документам фильтр работает. Если все флажки сняты, то фильтр полностью по столбцу D отключается.

К сообщению приложен файл: ___.xlsm (29.1 Kb)

Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.

Ответить

Дата: Воскресенье, 02.12.2018, 15:03 | Сообщение № 4

Группа: Проверенные

Ранг: Обитатель

Сообщений: 443

Репутация: 26 ±

Замечаний: 0% ±

Excel 2013

ovechkin1973, как вариант без флажков

К сообщению приложен файл: Report.xlsm (65.0 Kb)

Сообщение отредактировал parovoznik - Воскресенье, 02.12.2018, 15:03

Ответить

Дата: Воскресенье, 02.12.2018, 15:41 | Сообщение № 5

Группа: Друзья

Ранг: Ветеран

Сообщений: 559

Репутация: 167 ±

Замечаний: 0% ±

365

ovechkin1973,
с вашими флажками, но только я их слегка попереименовывал
и форму сделал не модальной

К сообщению приложен файл: 0776997.xlsm (33.5 Kb)

Ответить

Дата: Воскресенье, 02.12.2018, 17:37 | Сообщение № 6

Группа: Проверенные

Ранг: Обитатель

Сообщений: 429

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

parovoznik, мда.. в моем файле есть скрытый лист, куда часто пишу свои хотелки по доработки файла.. То, что предложили вы - тоже есть, только в моем случаю я более сложную задачу поставил и поэтому даже пока о реализации ее не заикаюсь.
Спасибо! Сохраню в копилку и обязательно попробую применить на своем файле.. хотя код для меня пока не "подъемный"...

Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.

Ответить

Дата: Воскресенье, 02.12.2018, 17:41 | Сообщение № 7

Группа: Проверенные

Ранг: Обитатель

Сообщений: 429

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

boa, ваш вариант самое то! попробую в первую очередь его приспособить к своему файлу..

Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.

Ответить

Дата: Воскресенье, 02.12.2018, 18:50 | Сообщение № 8

Группа: Проверенные

Ранг: Обитатель

Сообщений: 429

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Цитата ovechkin1973, 02.12.2018 в 17:41, в сообщении № 7 ()

boa, ваш вариант самое то! попробую в первую очередь его приспособить к своему файлу..

Приспособить фильтр по документам получилось.. сделал конечно не представляя, как работает...но цель достигнута! По дате пока не приспособил фильтр.. буду на работе сразу на рабочем файле пробовать.
Еще раз спасибо за помощь!

Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.

Ответить

Дата: Воскресенье, 02.12.2018, 19:40 | Сообщение № 9

Группа: Друзья

Ранг: Ветеран

Сообщений: 559

Репутация: 167 ±

Замечаний: 0% ±

365

ovechkin1973,
Обратите внимание на имена чекбоксов и то, что в фильтр подставляется капчя чекбокса, т.е. то, что в нем написано. Лишний пробел или запятая и т.п. изменят результат

Ответить

Дата: Понедельник, 03.12.2018, 05:33 | Сообщение № 10

Группа: Проверенные

Ранг: Обитатель

Сообщений: 429

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Цитата boa, 02.12.2018 в 19:40, в сообщении № 9 ()

Обратите внимание на имена чекбоксов и то, что в фильтр подставляется капчя чекбокса, т.е. то, что в нем написано. Лишний пробел или запятая и т.п. изменят результат

Уже обратил.. учусь на своих ошибках...

Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.

Ответить

Дата: Четверг, 27.12.2018, 18:30 | Сообщение № 11

Группа: Проверенные

Ранг: Обитатель

Сообщений: 429

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

boa, пробовал немного доработать форму и код.. получился затык. Я на форме флажки для столбца "В" нарисовал, код вроде по аналогии написал, но когда ставлю флажок - все строки исчезают. Вроде все проверил - имена в чекбоксе и фильтре идентичны.. Что не так делаю?

[vba]

Код

' Author:  boa
' Written: 02.12.2018
' http://www.excelworld.ru/forum/10-40001-1

Option Explicit

Private Sub ChBox_Type1_Click(): filterType: End Sub
Private Sub ChBox_Type2_Click(): filterType: End Sub
Private Sub ChBox_Type3_Click(): filterType: End Sub
Private Sub ChBox_Type4_Click(): filterType: End Sub
Private Sub ChBox_Type5_Click(): filterType: End Sub
Private Sub ChBox_Type6_Click(): filterType: End Sub
Private Sub ChBox_Type7_Click(): filterType: End Sub

Private Sub ChBox_Year16_Click(): filterYear: End Sub
Private Sub ChBox_Year17_Click(): filterYear: End Sub
Private Sub ChBox_Year18_Click(): filterYear: End Sub

Private Sub ChBox_TypeB1_Click(): filterType: End Sub
Private Sub ChBox_TypeB2_Click(): filterType: End Sub
Private Sub ChBox_TypeB3_Click(): filterType: End Sub
Private Sub ChBox_TypeB4_Click(): filterType: End Sub
Private Sub ChBox_TypeB5_Click(): filterType: End Sub
Private Sub ChBox_TypeB6_Click(): filterType: End Sub
Private Sub ChBox_TypeB7_Click(): filterType: End Sub
Private Sub ChBox_TypeB8_Click(): filterType: End Sub
Private Sub ChBox_TypeB9_Click(): filterType: End Sub

Private Sub filterTypeB() 'Фильтр по столбцу "B"
    Dim Ch As Control
    Dim myArr(), i&

    For Each Ch In Me.Controls
     If InStr(Ch.Name, "Type") And Ch.Value Then
        i = i + 1
        ReDim Preserve myArr(1 To i)
        myArr(i) = Ch.Caption
     End If
    Next
    If i > 0 Then
        ActiveSheet.UsedRange.AutoFilter Field:=2, _
                Operator:=xlFilterValues, _
                Criteria1:=myArr
    Else
        ActiveSheet.UsedRange.AutoFilter Field:=2
    End If
End Sub

Private Sub filterType() 'Фильтр по столбцу "М"
    Dim Ch As Control
    Dim myArr(), i&

    For Each Ch In Me.Controls
     If InStr(Ch.Name, "Type") And Ch.Value Then
        i = i + 1
        ReDim Preserve myArr(1 To i)
        myArr(i) = Ch.Caption
     End If
    Next
    If i > 0 Then
        ActiveSheet.UsedRange.AutoFilter Field:=13, _
                Operator:=xlFilterValues, _
                Criteria1:=myArr
    Else
        ActiveSheet.UsedRange.AutoFilter Field:=13
    End If
End Sub

Private Sub filterYear() 'Фильтр по столбцу "G"
    Dim Ch As Control
    Dim myArr(), i&

    For Each Ch In Me.Controls
     If InStr(Ch.Name, "Year") And Ch.Value Then
        i = i + 2
        ReDim Preserve myArr(1 To i)
        myArr(i - 1) = 0
        myArr(i) = "12/31/" & Ch.Caption
     End If
    Next
    If i > 0 Then
        ActiveSheet.UsedRange.AutoFilter Field:=7, _
                Operator:=xlFilterValues, _
                Criteria2:=myArr
    Else
        ActiveSheet.UsedRange.AutoFilter Field:=7
    End If
End Sub

[/vba]

boa, пробовал немного доработать форму и код.. получился затык. Я на форме флажки для столбца "В" нарисовал, код вроде по аналогии написал, но когда ставлю флажок - все строки исчезают. Вроде все проверил - имена в чекбоксе и фильтре идентичны.. Что не так делаю?

[vba]

Код

' Author:  boa
' Written: 02.12.2018
' http://www.excelworld.ru/forum/10-40001-1

Option Explicit

Private Sub ChBox_Type1_Click(): filterType: End Sub
Private Sub ChBox_Type2_Click(): filterType: End Sub
Private Sub ChBox_Type3_Click(): filterType: End Sub
Private Sub ChBox_Type4_Click(): filterType: End Sub
Private Sub ChBox_Type5_Click(): filterType: End Sub
Private Sub ChBox_Type6_Click(): filterType: End Sub
Private Sub ChBox_Type7_Click(): filterType: End Sub

Private Sub ChBox_Year16_Click(): filterYear: End Sub
Private Sub ChBox_Year17_Click(): filterYear: End Sub
Private Sub ChBox_Year18_Click(): filterYear: End Sub

Private Sub ChBox_TypeB1_Click(): filterType: End Sub
Private Sub ChBox_TypeB2_Click(): filterType: End Sub
Private Sub ChBox_TypeB3_Click(): filterType: End Sub
Private Sub ChBox_TypeB4_Click(): filterType: End Sub
Private Sub ChBox_TypeB5_Click(): filterType: End Sub
Private Sub ChBox_TypeB6_Click(): filterType: End Sub
Private Sub ChBox_TypeB7_Click(): filterType: End Sub
Private Sub ChBox_TypeB8_Click(): filterType: End Sub
Private Sub ChBox_TypeB9_Click(): filterType: End Sub

Private Sub filterTypeB() 'Фильтр по столбцу "B"
    Dim Ch As Control
    Dim myArr(), i&

    For Each Ch In Me.Controls
     If InStr(Ch.Name, "Type") And Ch.Value Then
        i = i + 1
        ReDim Preserve myArr(1 To i)
        myArr(i) = Ch.Caption
     End If
    Next
    If i > 0 Then
        ActiveSheet.UsedRange.AutoFilter Field:=2, _
                Operator:=xlFilterValues, _
                Criteria1:=myArr
    Else
        ActiveSheet.UsedRange.AutoFilter Field:=2
    End If
End Sub

Private Sub filterType() 'Фильтр по столбцу "М"
    Dim Ch As Control
    Dim myArr(), i&

    For Each Ch In Me.Controls
     If InStr(Ch.Name, "Type") And Ch.Value Then
        i = i + 1
        ReDim Preserve myArr(1 To i)
        myArr(i) = Ch.Caption
     End If
    Next
    If i > 0 Then
        ActiveSheet.UsedRange.AutoFilter Field:=13, _
                Operator:=xlFilterValues, _
                Criteria1:=myArr
    Else
        ActiveSheet.UsedRange.AutoFilter Field:=13
    End If
End Sub

Private Sub filterYear() 'Фильтр по столбцу "G"
    Dim Ch As Control
    Dim myArr(), i&

    For Each Ch In Me.Controls
     If InStr(Ch.Name, "Year") And Ch.Value Then
        i = i + 2
        ReDim Preserve myArr(1 To i)
        myArr(i - 1) = 0
        myArr(i) = "12/31/" & Ch.Caption
     End If
    Next
    If i > 0 Then
        ActiveSheet.UsedRange.AutoFilter Field:=7, _
                Operator:=xlFilterValues, _
                Criteria2:=myArr
    Else
        ActiveSheet.UsedRange.AutoFilter Field:=7
    End If
End Sub

[/vba]

Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.

Сообщение отредактировал ovechkin1973 - Четверг, 27.12.2018, 18:31

Ответить

Сообщениеboa, пробовал немного доработать форму и код.. получился затык. Я на форме флажки для столбца "В" нарисовал, код вроде по аналогии написал, но когда ставлю флажок - все строки исчезают. Вроде все проверил - имена в чекбоксе и фильтре идентичны.. Что не так делаю?

[vba]

Код

' Author:  boa
' Written: 02.12.2018
' http://www.excelworld.ru/forum/10-40001-1

Option Explicit

Private Sub ChBox_Type1_Click(): filterType: End Sub
Private Sub ChBox_Type2_Click(): filterType: End Sub
Private Sub ChBox_Type3_Click(): filterType: End Sub
Private Sub ChBox_Type4_Click(): filterType: End Sub
Private Sub ChBox_Type5_Click(): filterType: End Sub
Private Sub ChBox_Type6_Click(): filterType: End Sub
Private Sub ChBox_Type7_Click(): filterType: End Sub

Private Sub ChBox_Year16_Click(): filterYear: End Sub
Private Sub ChBox_Year17_Click(): filterYear: End Sub
Private Sub ChBox_Year18_Click(): filterYear: End Sub

Private Sub ChBox_TypeB1_Click(): filterType: End Sub
Private Sub ChBox_TypeB2_Click(): filterType: End Sub
Private Sub ChBox_TypeB3_Click(): filterType: End Sub
Private Sub ChBox_TypeB4_Click(): filterType: End Sub
Private Sub ChBox_TypeB5_Click(): filterType: End Sub
Private Sub ChBox_TypeB6_Click(): filterType: End Sub
Private Sub ChBox_TypeB7_Click(): filterType: End Sub
Private Sub ChBox_TypeB8_Click(): filterType: End Sub
Private Sub ChBox_TypeB9_Click(): filterType: End Sub

Private Sub filterTypeB() 'Фильтр по столбцу "B"
    Dim Ch As Control
    Dim myArr(), i&

    For Each Ch In Me.Controls
     If InStr(Ch.Name, "Type") And Ch.Value Then
        i = i + 1
        ReDim Preserve myArr(1 To i)
        myArr(i) = Ch.Caption
     End If
    Next
    If i > 0 Then
        ActiveSheet.UsedRange.AutoFilter Field:=2, _
                Operator:=xlFilterValues, _
                Criteria1:=myArr
    Else
        ActiveSheet.UsedRange.AutoFilter Field:=2
    End If
End Sub

Private Sub filterType() 'Фильтр по столбцу "М"
    Dim Ch As Control
    Dim myArr(), i&

    For Each Ch In Me.Controls
     If InStr(Ch.Name, "Type") And Ch.Value Then
        i = i + 1
        ReDim Preserve myArr(1 To i)
        myArr(i) = Ch.Caption
     End If
    Next
    If i > 0 Then
        ActiveSheet.UsedRange.AutoFilter Field:=13, _
                Operator:=xlFilterValues, _
                Criteria1:=myArr
    Else
        ActiveSheet.UsedRange.AutoFilter Field:=13
    End If
End Sub

Private Sub filterYear() 'Фильтр по столбцу "G"
    Dim Ch As Control
    Dim myArr(), i&

    For Each Ch In Me.Controls
     If InStr(Ch.Name, "Year") And Ch.Value Then
        i = i + 2
        ReDim Preserve myArr(1 To i)
        myArr(i - 1) = 0
        myArr(i) = "12/31/" & Ch.Caption
     End If
    Next
    If i > 0 Then
        ActiveSheet.UsedRange.AutoFilter Field:=7, _
                Operator:=xlFilterValues, _
                Criteria2:=myArr
    Else
        ActiveSheet.UsedRange.AutoFilter Field:=7
    End If
End Sub

[/vba]

Автор - ovechkin1973
Дата добавления - 27.12.2018 в 18:30

Дата: Четверг, 27.12.2018, 18:40 | Сообщение № 12

Группа: Друзья

Ранг: Ветеран

Сообщений: 559

Репутация: 167 ±

Замечаний: 0% ±

365

ovechkin1973, вы лучше файл приложите, что бы можно было код пошагово посмотреть

Ответить

Дата: Пятница, 28.12.2018, 11:49 | Сообщение № 13

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

Вот я теряюсь в догадках — зачем натягивать сову на глобус и тащить кучу чекбоксов (которых к тому же с каждым годом будет становиться больше) туда, где напрашивается листбокс и кнопка Сброс?

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Ответить

Дата: Пятница, 28.12.2018, 16:14 | Сообщение № 14

Группа: Проверенные

Ранг: Обитатель

Сообщений: 429

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Цитата boa, 27.12.2018 в 18:40, в сообщении № 12 ()

вы лучше файл приложите, что бы можно было код пошагово посмотреть

реальный файл большой. Не смогу выложить. Попробую на примере код применить.. если не выйдет, то выложу доработанный пример.

Цитата StoTisteg, 28.12.2018 в 11:49, в сообщении № 13 ()

Вот я теряюсь в догадках — зачем натягивать сову на глобус и тащить кучу чекбоксов (которых к тому же с каждым годом будет становиться больше) туда, где напрашивается листбокс и кнопка Сброс?

Понял только про сову и глобус.. Листбокс тоже понятно.. А вот какое решение конкретно - нет

Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.

Ответить

Дата: Пятница, 28.12.2018, 19:06 | Сообщение № 15

Группа: Проверенные

Ранг: Обитатель

Сообщений: 429

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Цитата boa, 27.12.2018 в 18:40, в сообщении № 12 ()

лучше файл приложите

Приложил..

К сообщению приложен файл: ____1.xlsm (38.4 Kb)

Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.

Ответить

Дата: Пятница, 28.12.2018, 23:41 | Сообщение № 16

Группа: Друзья

Ранг: Ветеран

Сообщений: 559

Репутация: 167 ±

Замечаний: 0% ±

365

ovechkin1973,
внимательность прежде всего!!!
Private Sub ChBox_TypeB1_Click(): filterTypeB: End Sub
вы при клике выполняли не тот макрос

К сообщению приложен файл: 7130437.xlsm (38.4 Kb)

Ответить

Дата: Суббота, 29.12.2018, 12:03 | Сообщение № 17

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

Цитата ovechkin1973, 28.12.2018 в 16:14, в сообщении № 14 ()

А вот какое решение конкретно - нет

Выгрузить критерии в листбоксы и фильтровать при их изменении, а не перебирая чекбоксы.

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Ответить

Дата: Суббота, 29.12.2018, 12:09 | Сообщение № 18

Группа: Проверенные

Ранг: Обитатель

Сообщений: 429

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Цитата boa, 28.12.2018 в 23:41, в сообщении № 16 ()

внимательность прежде всего!!!

Благодарю! Тут не во внимательности дело.. а полном не понимании мною кода.
А форму немодальной вы сделали почему?

Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.

Ответить

Дата: Суббота, 29.12.2018, 12:12 | Сообщение № 19

Группа: Друзья

Ранг: Ветеран

Сообщений: 559

Репутация: 167 ±

Замечаний: 0% ±

365

ovechkin1973,
что бы можно было клацать по листу, прокручивать, что то менять в ячейках при открытой форме

Ответить

Маркрос для юзер формы с флажками (для фильтра) (Макросы/Sub)

Страница 1 из 1
1

© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!