Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 15.09.2015, 15:57   #1
zerbite
 
Регистрация: 15.09.2015
Сообщений: 4
По умолчанию Автофильтры по значению в активной ячейки

Добрый день, всем форумчанам.

Подскажите пожалуйста как на Visual Basic'e написать следующее решение.

Задача есть большой список фраз (порядка 140 000), которые находятся в одной колонке:
Код:
...
функции нормативного регулирования
функции единоличного исполнительного органа участника
функции государственной политики
функции выполняемые организациями
функции lenovo
принципы функции организация
постройте функцию y x
какую функцию нужно
для чего нужна функция
...
и есть в отдельной колонке (можно вынести на отдельный лист, или в отдельный файл) каждое отдельное слово из этих фраз (их порядка 14 000):
Код:
lenovo
x
y
выполняемые
государственной
для
единоличного
исполнительного
какую
нормативного
нужна
нужно
органа
организация
организациями
политики
постройте
принципы
регулирования
участника
функции
функцию
функция
чего
нужно что при выделении какой-то ячейки со словом из 2-го списка включался автофильтр и из первого списка бы отображались только те фразы, которые содержат выделенное слово.

Так чтобы на экране было два списка, в экселе можно было расположить на экране сразу два файла, и пробегаясь по одному из них, в другом бы сразу отображались бы фразы содержащие выделенное слово

на другом форуме я нашел код на VB (источник: http://www.cyberforum.ru/ms-excel/thread1091195.html)
Код:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
 If Intersect(Range("A3:D3"), Target) Is Nothing Then Exit Sub
   If Target = "" Then ActiveSheet.Range("$A$3:$D$293").AutoFilter Field:=Target.Column: Exit Sub
   ActiveSheet.Range("$A$3:$D$293").AutoFilter Field:=Target.Column, _
   Criteria1:="=*" & Target.Value & "*", Operator:=xlAnd
 End Sub

Но он работает только по значению в ячейки "A3:D3", а как его переделать чтобы он брал значение из выделенной ячейки? Подскажите
zerbite вне форума Ответить с цитированием
Старый 15.09.2015, 16:25   #2
Казанский
Старожил
 
Аватар для Казанский
 
Регистрация: 31.12.2010
Сообщений: 2,133
По умолчанию

Вместо A3:D3 поставьте диапазон, в котором находится искомое слово: A:A
Так как код будет находиться в модуле другого листа, надо поменять ActiveSheet на
Sheets("имя_листа_с_фразами").
exceleved@yandex.ru Яндекс.Деньги: 410011500007619
Казанский вне форума Ответить с цитированием
Старый 15.09.2015, 16:37   #3
zerbite
 
Регистрация: 15.09.2015
Сообщений: 4
По умолчанию

спасибо за ответ.

Цитата:
Сообщение от Казанский Посмотреть сообщение
Вместо A3:D3 поставьте диапазон, в котором находится искомое слово: A:A
не совсем вот тут понял, на что надо исправить? у меня колонка из 15000 ячеек, а фильтровать надо только по одной выделенной ячейке, на которой стоит курсор.

Цитата:
Сообщение от Казанский Посмотреть сообщение
Так как код будет находиться в модуле другого листа, надо поменять ActiveSheet на
Sheets("имя_листа_с_фразами").
тут понял и все исправил
zerbite вне форума Ответить с цитированием
Старый 15.09.2015, 23:03   #4
Казанский
Старожил
 
Аватар для Казанский
 
Регистрация: 31.12.2010
Сообщений: 2,133
По умолчанию

zerbite, тут и событие другое нужно, пробуйте
Вложения
Тип файла: xls zerbite.xls (35.5 Кб, 49 просмотров)
exceleved@yandex.ru Яндекс.Деньги: 410011500007619
Казанский вне форума Ответить с цитированием
Старый 16.09.2015, 00:09   #5
zerbite
 
Регистрация: 15.09.2015
Сообщений: 4
По умолчанию

Цитата:
Сообщение от Казанский Посмотреть сообщение
zerbite, тут и событие другое нужно, пробуйте
ОГРОМНОЕ СПАСИБО за ответ и за РЕШЕНИЕ!!! КЛАСС!!! все работает!!!

Еще два вопроса:
1) можно ли в условии фильтра прописать три условия через логическое сложение (или) ? (в интерфейсе я нашел только два условия и одно лог.операция)
Или фраза начинается с слова+пробел, или содержит пробел+слово+пробел, или заканчивает на пробел+слово ?
(правда возможен еще один вариант, когда слово одно во фразе и нет пробелов, оно же начало и оно же конец, но хотя бы это запрограммировать )
2)Иногда, несколько раз так было когда кликаешь по словам, они как будто залипаеют, как будто я кликаю по ним с зажатым ctrl , не знаете что это может быть, переоткрыл книгу сначала, вроде без глюков?
zerbite вне форума Ответить с цитированием
Старый 16.09.2015, 10:02   #6
Vja4eslav
Пользователь
 
Регистрация: 13.08.2011
Сообщений: 90
По умолчанию

Всем здравствуйте!
Уважаемый Казанский, а как Вы так сделали, что при открытии Вашего файла появляются два окна с листами из этого файла?
Пытался сам понять, но мозгов не хватило. Но очень интересно и полезно!
Будьте добры, найдите время и ответьте, пожалуйста.
Vja4eslav вне форума Ответить с цитированием
Старый 16.09.2015, 13:03   #7
zerbite
 
Регистрация: 15.09.2015
Сообщений: 4
По умолчанию

Цитата:
Сообщение от Vja4eslav Посмотреть сообщение
Всем здравствуйте!
Уважаемый Казанский, а как Вы так сделали, что при открытии Вашего файла появляются два окна с листами из этого файла?
Пытался сам понять, но мозгов не хватило. Но очень интересно и полезно!
Будьте добры, найдите время и ответьте, пожалуйста.
это даже я знаю. вот ссылка https://support.office.com/ru-ru/art...b-351b91a4dd3a
zerbite вне форума Ответить с цитированием
Старый 16.09.2015, 13:10   #8
Vja4eslav
Пользователь
 
Регистрация: 13.08.2011
Сообщений: 90
По умолчанию

Спасибо)
Буду знать теперь.
Vja4eslav вне форума Ответить с цитированием
Старый 16.09.2015, 16:05   #9
Казанский
Старожил
 
Аватар для Казанский
 
Регистрация: 31.12.2010
Сообщений: 2,133
По умолчанию

zerbite, я не совсем понял насчет слова+пробел.
Если использовать расширенный фильтр, можно прописать сколько угодно условий. В этом варианте Вы выделяете несколько ячеек с условиями с помощью Ctrl или Shift, условие фильтра формируется в ст. D, фильтр применяется к Лист1.
Почему-то после работы макроса в обоих окнах отображается Лист2, но это можно побороть, если вариант подойдет.
Код:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim d As Range, ws1 As Worksheet
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Set ws1 = Worksheets("Лист1") 'лист со списком
  Set Target = Intersect(Target, Columns(1))
  Set d = Cells(Rows.Count, "D").End(xlUp)
  If d.Row > 1 Then Range("D2", d).ClearContents
  If Target Is Nothing Then
    If ws1.FilterMode Then ws1.ShowAllData
  Else
    Target.Copy
    Range("D2").PasteSpecial xlPasteValues
    Set d = Range("D2", Cells(Rows.Count, "D").End(xlUp))
    d.Value = Evaluate("""*""&" & d.Address(, , Application.ReferenceStyle) & "&""*""")
    ws1.Range("A:A").AdvancedFilter xlFilterInPlace, Range("D1:D" & d.Count + 1)
  End If
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub
exceleved@yandex.ru Яндекс.Деньги: 410011500007619
Казанский вне форума Ответить с цитированием
Старый 16.09.2015, 19:32   #10
Казанский
Старожил
 
Аватар для Казанский
 
Регистрация: 31.12.2010
Сообщений: 2,133
По умолчанию

Переписал формирование диапазона критериев без "грязных приемчиков" - теперь переключения листа в первом окне нет.
Код:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim d As Range, ws1 As Worksheet, v(), i&
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Set ws1 = Worksheets("Лист1") 'лист со списком
  Set Target = Intersect(Target, Columns(1))
  Set d = Cells(Rows.Count, "D").End(xlUp)
  If d.Row > 1 Then Range("D2", d).ClearContents
  If Target Is Nothing Then
    If ws1.FilterMode Then ws1.ShowAllData
  Else
    ReDim v(1 To Target.Count, 1 To 1)
    For Each Target In Target.Cells
      i = i + 1
      v(i, 1) = "*" & Target.Value & "*"
    Next
    Range("D2").Resize(i).Value = v
    ws1.Range("A:A").AdvancedFilter xlFilterInPlace, Range("D1:D" & i + 1)
  End If
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub
exceleved@yandex.ru Яндекс.Деньги: 410011500007619
Казанский вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Значение ячейки на пересечении столбца и активной ячейки Lamo Microsoft Office Excel 2 27.07.2013 20:55
Возврат значения активной ячейки Пингвини Microsoft Office Excel 2 17.04.2012 15:48
Окрашивание активной ячейки ru3000 Microsoft Office Excel 33 14.03.2012 16:17
Определение позиции активной ячейки Nynexerasebe Microsoft Office Excel 2 30.06.2010 13:43
Данные в ячейке из активной ячейки. ru3000 Microsoft Office Excel 1 28.07.2009 05:29