Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Скрипт, заменяющий поиск через стандартный фильтр - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Скрипт, заменяющий поиск через стандартный фильтр (Макросы/Sub)
Скрипт, заменяющий поиск через стандартный фильтр
Mark1976 Дата: Воскресенье, 06.03.2016, 23:08 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 738
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
Всем привет. Может кто поможет? По 100 раз в день пользуюсь данным файлом (работаю в аптеке) проверяю цены на ЛС. Поиск осуществляю по штрих коду (колонка А). Через встроенный фильтр не удобно. Может можно написать макрос, который заменял поиск нужного штрих кода, и выводил информацию как при фильтрации? Буду признателен.
К сообщению приложен файл: lp2016-03-06-1.xls (95.0 Kb)


Сообщение отредактировал Mark1976 - Воскресенье, 06.03.2016, 23:08
 
Ответить
СообщениеВсем привет. Может кто поможет? По 100 раз в день пользуюсь данным файлом (работаю в аптеке) проверяю цены на ЛС. Поиск осуществляю по штрих коду (колонка А). Через встроенный фильтр не удобно. Может можно написать макрос, который заменял поиск нужного штрих кода, и выводил информацию как при фильтрации? Буду признателен.
Автор - Mark1976
Дата добавления - 06.03.2016 в 23:08
StoTisteg Дата: Воскресенье, 06.03.2016, 23:19 | Сообщение № 2
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Можно всё. Но что делать-то нужно? Конкретно, что куда вводим и какой должен быть результат? Можно сделать форму, в которую Вы вбиваете код и она Вам выдаёт... Что выдаёт?

Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеМожно всё. Но что делать-то нужно? Конкретно, что куда вводим и какой должен быть результат? Можно сделать форму, в которую Вы вбиваете код и она Вам выдаёт... Что выдаёт?
Автор - StoTisteg
Дата добавления - 06.03.2016 в 23:19
Mark1976 Дата: Воскресенье, 06.03.2016, 23:20 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 738
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
Минуту.
 
Ответить
СообщениеМинуту.
Автор - Mark1976
Дата добавления - 06.03.2016 в 23:20
Mark1976 Дата: Воскресенье, 06.03.2016, 23:23 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 738
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
Вбиваем допустим этот штрих код: 4030855504565, получаем на экране одну строку с товаром: Ондансетрон
 
Ответить
СообщениеВбиваем допустим этот штрих код: 4030855504565, получаем на экране одну строку с товаром: Ондансетрон
Автор - Mark1976
Дата добавления - 06.03.2016 в 23:23
Mark1976 Дата: Воскресенье, 06.03.2016, 23:24 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 738
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
Просто хочется упростить процесс поиска и вывода.
 
Ответить
СообщениеПросто хочется упростить процесс поиска и вывода.
Автор - Mark1976
Дата добавления - 06.03.2016 в 23:24
StoTisteg Дата: Воскресенье, 06.03.2016, 23:26 | Сообщение № 6
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Понятно, попробуем.

Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеПонятно, попробуем.
Автор - StoTisteg
Дата добавления - 06.03.2016 в 23:26
МВТ Дата: Воскресенье, 06.03.2016, 23:32 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 476
Репутация: 137 ±
Замечаний: 0% ±

Excel 2007
Можно так, например[vba]
Код
Option Explicit
Sub tt()
    On Error Resume Next
    Dim I
    I = InputBox("Введите штрихкод")
    If I = "" Then Exit Sub
    With Range("Лист_1")
        .AutoFilter Field:=1, Criteria1:="*"
        .AutoFilter Field:=1, Criteria1:=I
    End With
End Sub
[/vba]
P.S. А вывод синонимов по МНН нужен?
UPD Вроде работает (по штрих-коду фильтрует еще и аналоги)
[vba]
Код
Sub tt()
    Application.ScreenUpdating = False
    On Error Resume Next
    Dim I, S As String, L As Long
    I = InputBox("Введите штрихкод")
    If I = "" Then Exit Sub
    With Range("Лист_1")
        L = WorksheetFunction.Match(I, .Columns(1), 0)
        If Err Then Exit Sub
        .AutoFilter Field:=2, Criteria1:="*"
        .AutoFilter Field:=2, Criteria1:=.Cells(L, 2)
    End With
    Application.ScreenUpdating = True
End Sub
[/vba]


Сообщение отредактировал МВТ - Воскресенье, 06.03.2016, 23:44
 
Ответить
СообщениеМожно так, например[vba]
Код
Option Explicit
Sub tt()
    On Error Resume Next
    Dim I
    I = InputBox("Введите штрихкод")
    If I = "" Then Exit Sub
    With Range("Лист_1")
        .AutoFilter Field:=1, Criteria1:="*"
        .AutoFilter Field:=1, Criteria1:=I
    End With
End Sub
[/vba]
P.S. А вывод синонимов по МНН нужен?
UPD Вроде работает (по штрих-коду фильтрует еще и аналоги)
[vba]
Код
Sub tt()
    Application.ScreenUpdating = False
    On Error Resume Next
    Dim I, S As String, L As Long
    I = InputBox("Введите штрихкод")
    If I = "" Then Exit Sub
    With Range("Лист_1")
        L = WorksheetFunction.Match(I, .Columns(1), 0)
        If Err Then Exit Sub
        .AutoFilter Field:=2, Criteria1:="*"
        .AutoFilter Field:=2, Criteria1:=.Cells(L, 2)
    End With
    Application.ScreenUpdating = True
End Sub
[/vba]
Автор - МВТ
Дата добавления - 06.03.2016 в 23:32
Mark1976 Дата: Воскресенье, 06.03.2016, 23:48 | Сообщение № 8
Группа: Проверенные
Ранг: Ветеран
Сообщений: 738
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
МВТ, отлично. Спасибо. Вот только чет не пойму как его (макрос) корректно сохранить в книгу Персональ. Вывод ножен еще по колонке:Торговое наименование лекарственного препарата. МНН можно не использовать.
 
Ответить
СообщениеМВТ, отлично. Спасибо. Вот только чет не пойму как его (макрос) корректно сохранить в книгу Персональ. Вывод ножен еще по колонке:Торговое наименование лекарственного препарата. МНН можно не использовать.
Автор - Mark1976
Дата добавления - 06.03.2016 в 23:48
Mark1976 Дата: Воскресенье, 06.03.2016, 23:57 | Сообщение № 9
Группа: Проверенные
Ранг: Ветеран
Сообщений: 738
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
МВТ, Все просто супер. Спасибо !!!
 
Ответить
СообщениеМВТ, Все просто супер. Спасибо !!!
Автор - Mark1976
Дата добавления - 06.03.2016 в 23:57
МВТ Дата: Воскресенье, 06.03.2016, 23:57 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 476
Репутация: 137 ±
Замечаний: 0% ±

Excel 2007
1. А почему его нельзя сохранить в рабочем файле? Если в персональной книге макросов, попробуйте так: With ActiveWorkbook.ActiveSheet.Range("Лист_1")
2. По торговому, так по торговому, но по МНН - правильнее, сами знаете, под одним МНН могут быть десятки торговых. Просто замените 2 на 3:
[vba]
Код
.AutoFilter Field:=3, Criteria1:="*"
.AutoFilter Field:=2, Criteria1:=.Cells(L, 3)
[/vba]
P.S. алаверды: у Вас случайно нет файлика с латинскими названиями по МНН? В РЛС почему-то латинских названий нет :(


Сообщение отредактировал МВТ - Понедельник, 07.03.2016, 00:00
 
Ответить
Сообщение1. А почему его нельзя сохранить в рабочем файле? Если в персональной книге макросов, попробуйте так: With ActiveWorkbook.ActiveSheet.Range("Лист_1")
2. По торговому, так по торговому, но по МНН - правильнее, сами знаете, под одним МНН могут быть десятки торговых. Просто замените 2 на 3:
[vba]
Код
.AutoFilter Field:=3, Criteria1:="*"
.AutoFilter Field:=2, Criteria1:=.Cells(L, 3)
[/vba]
P.S. алаверды: у Вас случайно нет файлика с латинскими названиями по МНН? В РЛС почему-то латинских названий нет :(
Автор - МВТ
Дата добавления - 06.03.2016 в 23:57
Mark1976 Дата: Понедельник, 07.03.2016, 00:04 | Сообщение № 11
Группа: Проверенные
Ранг: Ветеран
Сообщений: 738
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
МВТ, спасибо. вот только не всегда срабатывает почему то.
 
Ответить
СообщениеМВТ, спасибо. вот только не всегда срабатывает почему то.
Автор - Mark1976
Дата добавления - 07.03.2016 в 00:04
Mark1976 Дата: Понедельник, 07.03.2016, 00:31 | Сообщение № 12
Группа: Проверенные
Ранг: Ветеран
Сообщений: 738
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
Не срабатывает в этом файле.
К сообщению приложен файл: 123.xls (51.5 Kb)
 
Ответить
СообщениеНе срабатывает в этом файле.
Автор - Mark1976
Дата добавления - 07.03.2016 в 00:31
StoTisteg Дата: Понедельник, 07.03.2016, 00:43 | Сообщение № 13
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Mark1976, проверяйте с формой. Макрос висит на кнопке Проверить.
К сообщению приложен файл: 0127685.xlsm (39.9 Kb)

Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеMark1976, проверяйте с формой. Макрос висит на кнопке Проверить.
Автор - StoTisteg
Дата добавления - 07.03.2016 в 00:43
Mark1976 Дата: Понедельник, 07.03.2016, 00:46 | Сообщение № 14
Группа: Проверенные
Ранг: Ветеран
Сообщений: 738
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
StoTisteg, здорово. А вот этот штрих код:6922274400185 имеет 2 цены. Мне важно видеть все цены с этим кодом.
 
Ответить
СообщениеStoTisteg, здорово. А вот этот штрих код:6922274400185 имеет 2 цены. Мне важно видеть все цены с этим кодом.
Автор - Mark1976
Дата добавления - 07.03.2016 в 00:46
Mark1976 Дата: Понедельник, 07.03.2016, 00:47 | Сообщение № 15
Группа: Проверенные
Ранг: Ветеран
Сообщений: 738
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
StoTisteg, а как применить этот пример к новому файлу?. Я каждый день этот файл обновляю.
 
Ответить
СообщениеStoTisteg, а как применить этот пример к новому файлу?. Я каждый день этот файл обновляю.
Автор - Mark1976
Дата добавления - 07.03.2016 в 00:47
StoTisteg Дата: Понедельник, 07.03.2016, 00:48 | Сообщение № 16
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Ща придумаем...

Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеЩа придумаем...
Автор - StoTisteg
Дата добавления - 07.03.2016 в 00:48
StoTisteg Дата: Понедельник, 07.03.2016, 00:49 | Сообщение № 17
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Цитата Mark1976, 07.03.2016 в 00:47, в сообщении № 15
Я каждый день этот файл обновляю

Тогда сейчас переделаю в отдельный файл.

Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
Сообщение
Цитата Mark1976, 07.03.2016 в 00:47, в сообщении № 15
Я каждый день этот файл обновляю

Тогда сейчас переделаю в отдельный файл.
Автор - StoTisteg
Дата добавления - 07.03.2016 в 00:49
Mark1976 Дата: Понедельник, 07.03.2016, 00:51 | Сообщение № 18
Группа: Проверенные
Ранг: Ветеран
Сообщений: 738
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
StoTisteg, спасибо. Уж извините за тупость. В макросах не разбираюсь. Зато лекарства знаю отлично.
 
Ответить
СообщениеStoTisteg, спасибо. Уж извините за тупость. В макросах не разбираюсь. Зато лекарства знаю отлично.
Автор - Mark1976
Дата добавления - 07.03.2016 в 00:51
Mark1976 Дата: Понедельник, 07.03.2016, 01:10 | Сообщение № 19
Группа: Проверенные
Ранг: Ветеран
Сообщений: 738
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
StoTisteg, вернее я каждый день скачиваю новый файл с сайта.
 
Ответить
СообщениеStoTisteg, вернее я каждый день скачиваю новый файл с сайта.
Автор - Mark1976
Дата добавления - 07.03.2016 в 01:10
StoTisteg Дата: Понедельник, 07.03.2016, 01:47 | Сообщение № 20
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Готово. Запускаете файл Проверка, а уж там одна большая кнопка, не спутаете :)
К сообщению приложен файл: 3636464.rar (43.7 Kb)

Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеГотово. Запускаете файл Проверка, а уж там одна большая кнопка, не спутаете :)
Автор - StoTisteg
Дата добавления - 07.03.2016 в 01:47
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Скрипт, заменяющий поиск через стандартный фильтр (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!