Добрый день,
Вопрос.
Есть таблица с большим количеством столбцов 20+ и строк 1000+.
Пользователь выделяет в некоторых столбцах одну ячейку по значению из которой нужно установить фильтр.
Далее вызывается макрос, который фильтрует каждый столбец в котором есть выделенная ячейка, столбец фильтруется в соответствии со значением выделенной ячейки в этом столбце.
Может кто подскажет как сразу для нескольких столбцов можно сделать макрос?
Пока удалось только для одного столбца сделать:
Вопрос.
Есть таблица с большим количеством столбцов 20+ и строк 1000+.
Пользователь выделяет в некоторых столбцах одну ячейку по значению из которой нужно установить фильтр.
Далее вызывается макрос, который фильтрует каждый столбец в котором есть выделенная ячейка, столбец фильтруется в соответствии со значением выделенной ячейки в этом столбце.
Может кто подскажет как сразу для нескольких столбцов можно сделать макрос?
Пока удалось только для одного столбца сделать:
| Код |
|---|
Sub Otbor()
' отбор текущего параметра
curr_row = ActiveCell.Row
curr_col = ActiveCell.Column
curr_last = ActiveCell.SpecialCells(xlLastCell).Row
Set ns = ActiveSheet
Cells(curr_row, curr_col).Select
name_str = Cells(curr_row, curr_col).Value
If IsError(name_str) Then
If name_str = CVErr(xlErrNA) Then name_str = ""
If ActiveCell.Text Like "[#]*" Then
' Фильтр на ошибки
Select Case ActiveCell.Text
Case "#ДЕЛ/0!"
Selection.AutoFilter Field:=curr_col, Criteria1:="#ДЕЛ/0!"
Exit Sub
Case "#Н/Д"
Selection.AutoFilter Field:=curr_col, Criteria1:="#Н/Д"
Exit Sub
Case "#ИМЯ?"
Selection.AutoFilter Field:=curr_col, Criteria1:="#ИМЯ?"
Exit Sub
Case "#Имя!"
Selection.AutoFilter Field:=curr_col, Criteria1:="#Имя!"
Exit Sub
Case "#ЧИСЛО!"
Selection.AutoFilter Field:=curr_col, Criteria1:="#ЧИСЛО!"
Exit Sub
Case "#ССЫЛКА!"
Selection.AutoFilter Field:=curr_col, Criteria1:="#ССЫЛКА!"
Exit Sub
Case "#ЗНАЧ!"
Selection.AutoFilter Field:=curr_col, Criteria1:="#ЗНАЧ!"
Exit Sub
End Select
End If
End If
If name_str <> "" Then
If IsDate(name_str) Then
d1 = Trim(str(Day(name_str)))
If Len(d1) = 1 Then
d1 = "0" + d1
End If
m1 = Trim(str(Month(name_str)))
If Len(m1) = 1 Then
m1 = "0" + m1
End If
y1 = Trim(str(Year(name_str)))
If Len(y1) = 1 Then
y1 = "0" + y1
End If
cr1 = "=" + y1 + m1 + d1
Cells(curr_row, curr_col).Select
Selection.AutoFilter Field:=curr_col, Criteria1:=cr1
Else
Criteria1_ST = Cells(curr_row, curr_col).Value
If IsNumeric(Selection.Value) Then
cr1 = Trim("=") + Trim(str(Criteria1_ST))
Selection.AutoFilter Field:=curr_col, Criteria1:=cr1
Else
Selection.AutoFilter Field:=curr_col, Criteria1:="=" + LTrim(Criteria1_ST), Operator:=xlAnd
End If
End If
Else
Selection.AutoFilter Field:=curr_col, Criteria1:="="
End If
Cells(curr_row, curr_col).Select
End Sub |
