Коллеги, добрый день, Прошу помочь в дополнении существующего макроса (автор_Boroda_). Суть заключается в следующем, смог дописать код только на одну дополнительную ячейку поиска, если дописываю по такому же принципу еще одну строку, ячейка отказывается сортировать значения. Прикрепляю 2 файла : Пример 1 - это файл с измененным мною кодом _1_2 - это исходный файл, который попробовал переделать под свои нужды.
В файле Пример 1 описал желаемые изменения в этом макросе, если кто то может помочь в этом вопросе, был бы премного благодарен.
Коллеги, добрый день, Прошу помочь в дополнении существующего макроса (автор_Boroda_). Суть заключается в следующем, смог дописать код только на одну дополнительную ячейку поиска, если дописываю по такому же принципу еще одну строку, ячейка отказывается сортировать значения. Прикрепляю 2 файла : Пример 1 - это файл с измененным мною кодом _1_2 - это исходный файл, который попробовал переделать под свои нужды.
В файле Пример 1 описал желаемые изменения в этом макросе, если кто то может помочь в этом вопросе, был бы премного благодарен.Fogs
К сообщению приложен файл:_1_2.xlsb
(37.9 Kb)
·
_1.xlsb
(18.3 Kb)
Сообщение отредактировал Fogs - Среда, 17.01.2018, 15:04
fan-vba, спасибо, проверил, макрос рабочий, но искать в столбике ИНДЕКС (в котором цифровые значения) - все равно не хочет, как только вводишь значение в ячейку поиска - фильтр сортирует все данные, но ничего не выделяет. Очень помогла кнопка сбросить все фильтры, интуитивно понятная любому пользователю
fan-vba, спасибо, проверил, макрос рабочий, но искать в столбике ИНДЕКС (в котором цифровые значения) - все равно не хочет, как только вводишь значение в ячейку поиска - фильтр сортирует все данные, но ничего не выделяет. Очень помогла кнопка сбросить все фильтры, интуитивно понятная любому пользователюFogs
Fogs, интересная ваша тема. Тем самым заинтересовался и начал прочесывать просторы интернета )))) но сам в макросах не силен. Работаю с ними по принципу как и ВЫ нашел поправил (как его понимаю или пытаюсь вначале "если простое решение" записать его а потом перенести в найденный файл) если не получилось то обращаюсь на форум... ЗА ПОМОЩЬЮ Что косаемо вашей темы: наткнулся вот на такую же тему: My WebPage попытался применить данную тему для вашей таблицы... :'( но потерпел не удачу может Вы более смекалистый и у вас получится... Смотрите вложение Сам фильтр начинает фильтрацию при внесении данных в строку "УСЛОВИЕ" (А2:F2) но ни чего не находит ((((( не могу понять почему
Нашел еще один хороший и простой вариант )))) НО с последним столбцом ИНДЕКС ((((( почему то не фильтрует смотрите файл изменил прикрепленный ЛИСТ 2 Почему то когда я его сохраняю и выкладываю на форум то шапка в условиях пропадает (((( скопируйте шапку таблицы в шапку условия и тогда будет работать
Fogs, интересная ваша тема. Тем самым заинтересовался и начал прочесывать просторы интернета )))) но сам в макросах не силен. Работаю с ними по принципу как и ВЫ нашел поправил (как его понимаю или пытаюсь вначале "если простое решение" записать его а потом перенести в найденный файл) если не получилось то обращаюсь на форум... ЗА ПОМОЩЬЮ Что косаемо вашей темы: наткнулся вот на такую же тему: My WebPage попытался применить данную тему для вашей таблицы... :'( но потерпел не удачу может Вы более смекалистый и у вас получится... Смотрите вложение Сам фильтр начинает фильтрацию при внесении данных в строку "УСЛОВИЕ" (А2:F2) но ни чего не находит ((((( не могу понять почему
Нашел еще один хороший и простой вариант )))) НО с последним столбцом ИНДЕКС ((((( почему то не фильтрует смотрите файл изменил прикрепленный ЛИСТ 2 Почему то когда я его сохраняю и выкладываю на форум то шапка в условиях пропадает (((( скопируйте шапку таблицы в шапку условия и тогда будет работатьlebensvoll
Fogs, ошибка в том, что автофильтр нужно сбрасывать, иначе фильтрация осуществляется в том, что отфильтровано, а не во всей таблице. [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim lr As Long If Intersect(Target, Range("E8:G8")) Is Nothing Then Exit Sub ActiveSheet.AutoFilter.ShowAllData lr = Cells(Rows.Count, "B").End(xlUp).Row ActiveSheet.Range("A10:G" & lr).AutoFilter Field:=5, Criteria1:="*" & Range("E8").Value & "*" ActiveSheet.Range("A10:G" & lr).AutoFilter Field:=6, Criteria1:="*" & Range("F8").Value & "*" End Sub
[/vba]
Fogs, ошибка в том, что автофильтр нужно сбрасывать, иначе фильтрация осуществляется в том, что отфильтровано, а не во всей таблице. [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim lr As Long If Intersect(Target, Range("E8:G8")) Is Nothing Then Exit Sub ActiveSheet.AutoFilter.ShowAllData lr = Cells(Rows.Count, "B").End(xlUp).Row ActiveSheet.Range("A10:G" & lr).AutoFilter Field:=5, Criteria1:="*" & Range("E8").Value & "*" ActiveSheet.Range("A10:G" & lr).AutoFilter Field:=6, Criteria1:="*" & Range("F8").Value & "*" End Sub
Karataev, прошу вас подскажите это вы говорите по примеру "Автора поста" или по моим двум примерам в (Дата: Четверг, 18.01.2018, 14:16 | Сообщение № 6) Мне просто теперь самому интересно, ведь я получается натыкаюсь на те же грабли )))) хотя хотел помочь... Заранее спасибо за ответ...
Karataev, прошу вас подскажите это вы говорите по примеру "Автора поста" или по моим двум примерам в (Дата: Четверг, 18.01.2018, 14:16 | Сообщение № 6) Мне просто теперь самому интересно, ведь я получается натыкаюсь на те же грабли )))) хотя хотел помочь... Заранее спасибо за ответ...lebensvoll
lebensvoll, спасибо большое за оба примера (кстати, пример с сайта я тоже пытался применить) , поиск по индексу работает, но тогда проблема возникает в том, что поисковая ячейка ищет только точные совпадения а здесь как раз стоит задача в том, чтоб любой пользователь в данном файле, даже зная только первые буквы мог бы найти необходимый серчнейм, а не записывал еще один такой же. Точно знаю, что проблему решили используя 1С, но к сожалению нет возможности работы с данной программой, поэтому приходится обращаться к старому, доброму Экселю
lebensvoll, спасибо большое за оба примера (кстати, пример с сайта я тоже пытался применить) , поиск по индексу работает, но тогда проблема возникает в том, что поисковая ячейка ищет только точные совпадения а здесь как раз стоит задача в том, чтоб любой пользователь в данном файле, даже зная только первые буквы мог бы найти необходимый серчнейм, а не записывал еще один такой же. Точно знаю, что проблему решили используя 1С, но к сожалению нет возможности работы с данной программой, поэтому приходится обращаться к старому, доброму Экселю Fogs
Поправьте, пожалуйста, если что то неправильно сделал (во вложении то, что получилось)
И да, фильтрацию необходимо проводить в том, что уже отфильтровано; например : знаю, что есть город, знаю в какой он находится области, ввожу область + ввожу город, потом ввожу улицу и получаю результат. или другой пример : знаю улицу и возможный город, ввожу улицу + ввожу приблизительное название города (или области) и получаю результат. Хотел бы получить вариант с максимально возможным количеством фильтрации ячеек.
Karataev, спасибо, попробовал прописать Ваш вариант макроса, работает, дописал еще одну строку:
Поправьте, пожалуйста, если что то неправильно сделал (во вложении то, что получилось)
И да, фильтрацию необходимо проводить в том, что уже отфильтровано; например : знаю, что есть город, знаю в какой он находится области, ввожу область + ввожу город, потом ввожу улицу и получаю результат. или другой пример : знаю улицу и возможный город, ввожу улицу + ввожу приблизительное название города (или области) и получаю результат. Хотел бы получить вариант с максимально возможным количеством фильтрации ячеек.Fogs
Проблема из-за того, что в столбце "G" данные в виде чисел. А условие для столбца "G" делается в текстовом формате. Можете сделать в столбце "G" формат "Текстовый" и заново перебить индексы? Или хотите оставить индексы так, как сейчас? В этом случае надо подумать, как составить условие. Кроме того, если индексы будут в виде чисел, то Вы не сможете фрагменты искать, например, не сможете отобрать индексы, которые начинаются на 23.
Проблема из-за того, что в столбце "G" данные в виде чисел. А условие для столбца "G" делается в текстовом формате. Можете сделать в столбце "G" формат "Текстовый" и заново перебить индексы? Или хотите оставить индексы так, как сейчас? В этом случае надо подумать, как составить условие. Кроме того, если индексы будут в виде чисел, то Вы не сможете фрагменты искать, например, не сможете отобрать индексы, которые начинаются на 23.Karataev
Сообщение отредактировал Karataev - Четверг, 18.01.2018, 17:00
Fogs, позднее пришла мысль. У Вас все правильно, только поиск последней строки не правильно, возможно с этим у Вас была проблема. Метод "End" ищет только в видимых строках, после фильтрации некоторые строки скрываются и последняя строка искалась до первой (снизу) видимой. Такой вариант:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long
If Intersect(Target, Range("E8:G8")) Is Nothing Then Exit Sub
If Target.Address(0, 0) = "E8" Then ActiveSheet.Range("A10:G" & lr).AutoFilter Field:=5, Criteria1:="*" & Target & "*" ElseIf Target.Address(0, 0) = "F8" Then ActiveSheet.Range("A10:G" & lr).AutoFilter Field:=6, Criteria1:="*" & Target & "*" End If
End Sub
[/vba]
Только для столбца "G" Вам надо учитывать, что сейчас там числа, а для чисел нужно другое условие, чем Вы используете для столбцов E:F.
То, что я предложил, там другой принцип, там каждый раз сбрасывается фильтр и затем заново задается по ячейкам E8:G8 слева направо. В этом случае уже будет фильтрация другая, будет нарушен исходный порядок фильтрации.
Fogs, позднее пришла мысль. У Вас все правильно, только поиск последней строки не правильно, возможно с этим у Вас была проблема. Метод "End" ищет только в видимых строках, после фильтрации некоторые строки скрываются и последняя строка искалась до первой (снизу) видимой. Такой вариант:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long
If Intersect(Target, Range("E8:G8")) Is Nothing Then Exit Sub
If Target.Address(0, 0) = "E8" Then ActiveSheet.Range("A10:G" & lr).AutoFilter Field:=5, Criteria1:="*" & Target & "*" ElseIf Target.Address(0, 0) = "F8" Then ActiveSheet.Range("A10:G" & lr).AutoFilter Field:=6, Criteria1:="*" & Target & "*" End If
End Sub
[/vba]
Только для столбца "G" Вам надо учитывать, что сейчас там числа, а для чисел нужно другое условие, чем Вы используете для столбцов E:F.
То, что я предложил, там другой принцип, там каждый раз сбрасывается фильтр и затем заново задается по ячейкам E8:G8 слева направо. В этом случае уже будет фильтрация другая, будет нарушен исходный порядок фильтрации.Karataev
Сообщение отредактировал Karataev - Четверг, 18.01.2018, 18:40
Karataev, преобразовал в текстовый формат, все равно индексы искать не хочет (выпрыгивает предложение в виде зеленого уголка, мол в ячейке цифра не хотите ли изменить формат), наверняка необходимо оставить цифры и задать другое условие, сейчас рыщу в интернете в поиске На данный момент реализовал все идеи высказанные в данном топике (спасибо огромное, ребята!) - вот что получилось (во вложении).
И сразу же возник вопрос по ходу действий в колонке C и D, где не заполнены поля, происходит интересная штука, поиск работает!, но не так, как в столбцах E и F, где поля заполнены полностью. Фишка в том, что при написании поискового значения в ячейке C и D фильтр срабатывает,но при удалении значения в поисковой ячейке - не возвращаются пустые строки, а остаются только заполненные значениями строки.
Есть идеи как это искоренить и сделать поиск таким же удобным ,как и в столбцах E и F? И естественно рад буду идеям в борьбе с поиском цифрового значения в ячейке G?
P.S. Пока что спасает кнопка сбросить фильтры, как по первому вопросу, так и по второму (тоже решение), но поисковой ячейки все равно не получается.
Karataev, преобразовал в текстовый формат, все равно индексы искать не хочет (выпрыгивает предложение в виде зеленого уголка, мол в ячейке цифра не хотите ли изменить формат), наверняка необходимо оставить цифры и задать другое условие, сейчас рыщу в интернете в поиске На данный момент реализовал все идеи высказанные в данном топике (спасибо огромное, ребята!) - вот что получилось (во вложении).
И сразу же возник вопрос по ходу действий в колонке C и D, где не заполнены поля, происходит интересная штука, поиск работает!, но не так, как в столбцах E и F, где поля заполнены полностью. Фишка в том, что при написании поискового значения в ячейке C и D фильтр срабатывает,но при удалении значения в поисковой ячейке - не возвращаются пустые строки, а остаются только заполненные значениями строки.
Есть идеи как это искоренить и сделать поиск таким же удобным ,как и в столбцах E и F? И естественно рад буду идеям в борьбе с поиском цифрового значения в ячейке G?
P.S. Пока что спасает кнопка сбросить фильтры, как по первому вопросу, так и по второму (тоже решение), но поисковой ячейки все равно не получается.Fogs
Fogs, в столбце "G" нужно не просто сделать формат "Текстовый", а нужно еще заново перепечатать все индексы, чтобы числа стали текстом. Для этого надо зайти в строку формул и ничего не делая нажать "Enter". Если Вы хотите оставить индексы в виде чисел, то нельзя будет искать фрагменты индексов, например, нельзя будет отобрать строки, у которых индексы начинаются на 23.
Fogs, в столбце "G" нужно не просто сделать формат "Текстовый", а нужно еще заново перепечатать все индексы, чтобы числа стали текстом. Для этого надо зайти в строку формул и ничего не делая нажать "Enter". Если Вы хотите оставить индексы в виде чисел, то нельзя будет искать фрагменты индексов, например, нельзя будет отобрать строки, у которых индексы начинаются на 23.Karataev
Сообщение отредактировал Karataev - Пятница, 19.01.2018, 08:00
Karataev, полный успех, работают все ячейки поиска, сортируют по нескольким значениям, кроме индекса, думаю дописать следующий код :
If Target.Address(0, 0) = "G8" Then ActiveSheet.Range("A10:G" & lr).AutoFilter Field:=7, Criteria1:="" & Target & "" End If
Для точного поиска по индексу и фильтрации, а кнопка Сброс фильтра будет помогать в этом. С учетом решения поиска по остальному массиву данных - индекс остается единственной неточностью и главное условие, в данном случае, чтоб сортировка по индексу шла отдельно и выставлялась в приоритет (просто вариант с изменением 360 к строк ввел меня в легкий ужас :))
В приложении выкладываю получившийся файл, надеюсь он пригодится кому-нибудь еще Тему можно закрывать
Karataev, полный успех, работают все ячейки поиска, сортируют по нескольким значениям, кроме индекса, думаю дописать следующий код :
If Target.Address(0, 0) = "G8" Then ActiveSheet.Range("A10:G" & lr).AutoFilter Field:=7, Criteria1:="" & Target & "" End If
Для точного поиска по индексу и фильтрации, а кнопка Сброс фильтра будет помогать в этом. С учетом решения поиска по остальному массиву данных - индекс остается единственной неточностью и главное условие, в данном случае, чтоб сортировка по индексу шла отдельно и выставлялась в приоритет (просто вариант с изменением 360 к строк ввел меня в легкий ужас :))
В приложении выкладываю получившийся файл, надеюсь он пригодится кому-нибудь еще Тему можно закрыватьFogs
Перевести числа в текст в столбце "G" можно попробовать не вручную, а макросом или еще чем (с ходу не знаю, как это сделать). Этот вариант для столбца "G", когда в нем числа в виде чисел и поиск возможен только по полному совпадению.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim lr As Long
If Intersect(Target, Range("B8:G8")) Is Nothing Then Exit Sub
If Target.Value = "" Then ActiveSheet.Range("A10:G" & lr).AutoFilter Field:=Target.Column Exit Sub End If
If Not Intersect(Target, Range("B8:F8")) Is Nothing Then ActiveSheet.Range("A10:G" & lr).AutoFilter Field:=Target.Column, Criteria1:="*" & Target & "*" ElseIf Target.Address(0, 0) = "G8" Then ActiveSheet.Range("A10:G" & lr).AutoFilter Field:=Target.Column, Criteria1:=Target End If End Sub
[/vba]
Перевести числа в текст в столбце "G" можно попробовать не вручную, а макросом или еще чем (с ходу не знаю, как это сделать). Этот вариант для столбца "G", когда в нем числа в виде чисел и поиск возможен только по полному совпадению.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim lr As Long
If Intersect(Target, Range("B8:G8")) Is Nothing Then Exit Sub
If Target.Value = "" Then ActiveSheet.Range("A10:G" & lr).AutoFilter Field:=Target.Column Exit Sub End If
If Not Intersect(Target, Range("B8:F8")) Is Nothing Then ActiveSheet.Range("A10:G" & lr).AutoFilter Field:=Target.Column, Criteria1:="*" & Target & "*" ElseIf Target.Address(0, 0) = "G8" Then ActiveSheet.Range("A10:G" & lr).AutoFilter Field:=Target.Column, Criteria1:=Target End If End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
:'( 
а здесь как раз стоит задача в том, чтоб любой пользователь в данном файле, даже зная только первые буквы мог бы найти необходимый серчнейм, а не записывал еще один такой же. Точно знаю, что проблему решили используя 1С, но к сожалению нет возможности работы с данной программой, поэтому приходится обращаться к старому, доброму Экселю 
