Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос для CheckBox. Фильтр по отмеченым чекбоксам, Помогите разобраться
 
#1
11.01.2014 17:48:19
Добрый день!
вот код макроса
Код
 Private Sub CommandButton1_Click() 
Application.ScreenUpdating = False 
If CheckBox1.Value = True Then 
Rows("1:1" ;) .Select 
Selection.AutoFilter 
ActiveSheet.Range("$A$1:$HL$60000" ;) .AutoFilter Field:=20, Criteria1:="1" 
ElseIf CheckBox2.Value = True Then 
Rows("1:1" ;) .Select 
Selection.AutoFilter 
ActiveSheet.Range("$A$1:$HL$60000" ;) .AutoFilter Field:=20, Criteria1:="2" 
ElseIf CheckBox3.Value = True Then 
Rows("1:1" ;) .Select 
Selection.AutoFilter 
ActiveSheet.Range("$A$1:$HL$60000" ;) .AutoFilter Field:=20, Criteria1:="3" 
ElseIf CheckBox5.Value = True Then 
Rows("1:1" ;) .Select 
Selection.AutoFilter 
ActiveSheet.Range("$A$1:$HL$60000" ;) .AutoFilter Field:=20, Criteria1:="4" 
ElseIf CheckBox7.Value = True Then 
Rows("1:1" ;) .Select 
Selection.AutoFilter 
ActiveSheet.Range("$A$1:$HL$60000" ;) .AutoFilter Field:=20, Criteria1:="5" 
ElseIf CheckBox6.Value = True Then 
Rows("1:1" ;) .Select 
Selection.AutoFilter 
ActiveSheet.Range("$A$1:$HL$60000" ;) .AutoFilter Field:=20, Criteria1:="6" 
ElseIf CheckBox8.Value = True Then 
Rows("1:1" ;) .Select 
Selection.AutoFilter 
ActiveSheet.Range("$A$1:$HL$60000" ;) .AutoFilter Field:=20, Criteria1:="7" 
ElseIf CheckBox4.Value = True Then 
Rows("1:1" ;) .Select 
Selection.AutoFilter 
ActiveSheet.Range("$A$1:$HL$60000" ;) .AutoFilter Field:=20, Criteria1:="8" 
ElseIf CheckBox9.Value = True Then 
Rows("1:1" ;) .Select 
Selection.AutoFilter 
ActiveSheet.Range("$A$1:$HL$60000" ;) .AutoFilter Field:=20, Criteria1:="9" 
End If 
Cells.Select 
Selection.Copy 
Sheets("Категории" ;) .Select 
Range("A1" ;) .Select 
Selection.PasteSpecial Paste:=xlPasteValues 
UserForm1.Hide 
End Sub
Сейчас при вызове формы и проставлении флажка на каком либо одном чекбоксе идет фильтр по одному критерию.
Не могу понять, как сделать так, чтобы я мог отметить несколько чекбоксов и фильтр происходил по разным критериям.
 
 
 
#2
11.01.2014 18:08:37
Вместо Конструкции If..Then..ElseIf..End If используйте цикл по ЧекБоксам и при ЧекБокс = истина фильтруйте Ваш диапазон. Ну или вложенные If...Then, но это громоздко. По логике Вашего кода - при нахождении первого отмеченного ЧекБокса диапазон фильтруется по этому критерию и выходит из проверки
Изменено: Sanja - 11.01.2014 18:11:43
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
11.01.2014 18:28:28
Спасибо за ответ. Но ничего не понял. Как делать цикл по чекбоксам? Пример можно написать? Спасибо
 
 
 
#4
11.01.2014 18:29:30
Приложите файл-пример. Лень чекбоксы рисовать :)
Согласие есть продукт при полном непротивлении сторон
 
 
 
#5
11.01.2014 18:30:28
Ловите
 
 
 
#6
11.01.2014 18:44:58
Нет чекбоксов, и не надо. Не больно-то и хотелось.
 
 
 
#7
11.01.2014 19:01:18
Попробуйте так вместо Вашего кода


Код
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False

With Me
For Each Control In .Frame1.Controls
    If TypeOf Control Is MSForms.CheckBox And Control.Value = True Then _
        ActiveSheet.Range("$A$1:$HL$60000").AutoFilter Field:=20, Criteria1:=I
Next

Cells.Select
    Selection.Copy
    Sheets("Категории").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    .Hide
End With

End Sub

в вашем файле после работы этой процедуры что-то фильтруется, но я не знаю как должен выглядеть результат "ПОСЛЕ", потестируйте сами
Согласие есть продукт при полном непротивлении сторон
 
 
 
#8
11.01.2014 19:35:07
Criteria1:=I

Что это за критерий?
Но если честно, вообще ничего не фильтруется
 
 
 
#9
11.01.2014 20:20:35
Кросс: http://www.excel-vba.ru/forum/index.php?topic=2706.0
Решение человек получил.

DeferKein, а вообще это ВЫ должны были отписать в своих темах на форумах, что вопрос решен.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#10
11.01.2014 20:23:38
Приношу извинения.
Кинулся изучать макрос и немного забылся
 
 
 
Страницы: 1
Наверх