Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: Пред. 1 2
RSS
Как при выборе значений в фильтре, отобразить выбранное условие фильтра в верхних ячейках, дайте ссылку
 
#31
16.04.2016 12:51:37
Работает.
Изменено: kuklp - 16.04.2016 12:52:16
Я сам - дурнее всякого примера! ...
 
 
 
#32
16.04.2016 12:53:41
Юрий М, Kuzmich написал
Цитата
Скачал ваш пример, ткнул кнопку ТЫК, в первой строке результат.
После преобразования в диапазон выдаёт "Type mismatch". Активная в таблице
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#33
16.04.2016 12:58:34
У меня работает и с умной таблицей
Посмотрите ваш пример
 
 
 
#34
16.04.2016 12:58:38
kuklp, в обычных диапазонах выдаёт "Subscript out of range". В умных таблицах прекрасно работает!)))) огромное вам спасибо!!!  :idea: 8) а почему у меня с тем проблемы были, подскажите пожалуйста? (если. конечно.  это можно объяснить НЕпрограммисту) ;)

P.S.: одна просьба - что исправить в коде, чтобы он в критериях НЕ дублировал "шапки", то есть оставлял ТОЛЬКО критерии (вместо Сотрудники: = Ира; =Ира), т.к. они стоят рядом и будет понятно, к какому полю относится. Понимаю, что нужно где-то в sMsg и sField поправить, но самостоятельно точно напортачу  :sceptic:
Изменено: Jack_Famous - 16.04.2016 13:17:20
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#35
16.04.2016 13:04:55
Цитата
Kuzmich написал: У меня работает и с умной таблицей
У меня с умной не хочет (2010)
Цитата
Jack_Famous написал: в обычных диапазонах выдаёт "Subscript out of range"
А у меня всё работает ) Причину не знаю.
 
 
 
#36
16.04.2016 13:08:03
Юрий М,  бабайка - не иначе)))) VBA-бабай  :D
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#37
16.04.2016 13:13:14
Kuzmich, (к посту #33) у меня нет(((( в этом примере всё тоже самое (см. скрин).
13:30. При преобразовании в обычный диапазон работает через раз - не понимаю, по какому принципу. То ошибку выдаёт, то критерии в несколько полей проставляет...
P.S.: кто-нибудь, помогите пожалуйста убрать заголовки полей из критериев....
Изменено: Jack_Famous - 16.04.2016 13:43:23
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#38
16.04.2016 15:14:24
По поводу "убрать имена полей из критериев"... Вроде бы решилось удалением "sField "...
Код
'Отобразить критерии автофильтра в 1 строке
'Условия: "умная" таблица со включеным автофильтром, начинающаяся НЕ ВЫШЕ 2 строки листа
'
'Автор: Kuzmich
'Редактор данной версии: kuklp
'Пытался убрать имена полей из критериев: Jack_Famous
'
'Тема: http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=76899&TITLE_SEO=76899-kak-pri-vybore-znacheniy-v-filtre-otobrazit-vybrannoe-uslovie-filtra-v
'===============================================================================================================================================================================

Sub ShowAutoFilterCriteria()

Dim oAF As AutoFilter, oFlt As Filter

'Dim sField As String

Dim sCrit1 As String, sCrit2 As String
Dim sMsg As String, i As Integer
 
Set oAF = ActiveSheet.ListObjects(1).AutoFilter
For i = 1 To oAF.Filters.Count 'Loop through the Filters of the AutoFilter

'   sField = oAF.Range.Cells(1, i).Value 'Get the field name from the first row of the AutoFilter range

   Set oFlt = oAF.Filters(i) 'Get the Filter object
   If oFlt.On Then 'If it is on...
   
     sMsg = sMsg & vbCrLf 'Get the standard filter criteria (sMsg = sMsg & vbCrLf & sField)
     
     If IsArray(oFlt.Criteria1) Then sMsg = sMsg & Join(oFlt.Criteria1) Else sMsg = sMsg & oFlt.Criteria1 'If it's a special filter, show it
    Select Case oFlt.Operator
     Case xlAnd
      sMsg = sMsg & " And " & oFlt.Criteria2 'sMsg = sMsg & " And " & sField & oFlt.Criteria2
     Case xlOr
      sMsg = sMsg & " Or " & oFlt.Criteria2 'sMsg = sMsg & " Or " & sField & oFlt.Criteria2
     Case xlBottom10Items
      sMsg = sMsg & " (bottom 10 items)"
     Case xlBottom10Percent
      sMsg = sMsg & " (bottom 10%)"
     Case xlTop10Items
      sMsg = sMsg & " (top 10 items)"
     Case xlTop10Percent
      sMsg = sMsg & " (top 10%)"
    End Select
   End If
   Cells(1, i) = sMsg
   sMsg = ""
Next

End Sub
пока конфликтов не найдено...
Изменено: Jack_Famous - 16.04.2016 15:47:46
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#39
16.04.2016 16:00:37
Jack_Famous,
Вот перевел весь код на Русский, в нем думаю сразу поймете что нужно поправить
Код
Sub КритерииАфтофильтра()
Dim оАфтоФилт As AutoFilter, оФилт As Filter
Dim ИмяФильтра As String
'Dim sCrit1 As String, sCrit2 As String
Dim Сообщение As String, i As Integer
'Проверить, если Таблица фильтруется вообще
If ActiveSheet.AutoFilterMode = False Then
   MsgBox "На листе Нет Автофильтров"
   Exit Sub
End If
'Получить объект Автофильтр Активного листа
Set оАфтоФилт = ActiveSheet.AutoFilter
'цикл по фильтрам Автофильтра
For i = 1 To оАфтоФилт.Filters.Count
   'Получить имя поля из первой строки
   'или AutoFilter range
   ИмяФильтра = оАфтоФилт.Range.Cells(1, i).Value
   'Получить объект фильтра
   Set оФилт = оАфтоФилт.Filters(i)
   'если есть фильтр If it is on...
   If оФилт.On Then
     'получить критерии фильтрации
     Сообщение = Сообщение & vbCrLf & ИмяФильтра & оФилт.Criteria1
     'Если это специальный фильтр, показать его
    Select Case оФилт.Operator
     Case xlAnd
      Сообщение = Сообщение & " И " & ИмяФильтра & оФилт.Criteria2
     Case xlOr
      Сообщение = Сообщение & " Или " & ИмяФильтра & оФилт.Criteria2
     Case xlBottom10Items
      Сообщение = Сообщение & " (bottom 10 items)"
     Case xlBottom10Percent
      Сообщение = Сообщение & " (bottom 10%)"
     Case xlTop10Items
      Сообщение = Сообщение & " (top 10 items)"
     Case xlTop10Percent
      Сообщение = Сообщение & " (top 10%)"
    End Select
   End If
   Cells(1, i) = Сообщение ' Кривой код, надо исправить
Next
If Сообщение = "" Then
   'Не применяются филтра
   Сообщение = "В диапозоне " & оАфтоФилт.Range.Address & " нет фильтров."
Else
   'Показ фильтров
   Сообщение = "В диапозоне " & оАфтоФилт.Range.Address & " стоят фильтра:" & Сообщение
End If
   'Выдать сообщение
   MsgBox Сообщение
End Sub
Изменено: Фродо - 16.04.2016 16:01:12
у меня простая версия Экселя, в ней нет кнопки "Прочитать мысли и сгенерировать файл пример"
 
 
 
#40
16.04.2016 16:37:58
Фродо, спасибо вам большое)) но проблема не в языке была, а в том, что внутри кода могли быть связи, которые бы я не увидел и просто удалением бы не обошлось - но вроде пронесло))
P.S.: вы перевели версию кода, который у меня не работает (2016) ;)
Изменено: Jack_Famous - 16.04.2016 16:38:55
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
Страницы: Пред. 1 2
Наверх