Создание пользовательской функции для поиска данных

Дата: Среда, 26.06.2019, 08:49 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 53

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Добрый день,

Прошу всех кто знает помочь. Необходимо создать пользовательскую функцию, которая будет работать согласно прописанной формуле в макросе. Внутри файла стоит формула. Необходимо ее прописать в макросе и сохранить как пользовательскую функцию, чтобы при наведении на код сразу отображался результат. Данная пользовательская функция необходима, чтобы файл меньше зависал из за длинной формулы, так как список большой. Спасибо

К сообщению приложен файл: 4566681.xlsx (9.6 Kb)

Сообщение отредактировал Аналитик2012 - Среда, 26.06.2019, 10:19

_Boroda_

Дата: Среда, 26.06.2019, 10:16 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 16718

Репутация: 6505 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

- Прочитайте Правила форума
- Исправьте название темы согласно п.2 Правил форума, конкретнее обозначьте проблему
- Что в Вашем понимании означает "при наведении на код сразу отображался результат"?
- Насколько большлй список в Лист2? Сколько примерно строк?

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Дата: Среда, 26.06.2019, 10:24 | Сообщение № 3

Группа: Пользователи

Ранг: Участник

Сообщений: 53

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

_Boroda_,

- по первому пункту подкорректировал
- по второму вашему вопросу: сейчас в листе 1 в ячейке С6 стоит формула

Код

(ЕСЛИОШИБКА(ЕСЛИ(B6="";"";ВПР(B6;Лист2!$B:$C;2;0));"проверить код"))

. Хотелось бы прописать эту формулу в макросе создав пользовательскую функцию с одним аргументом (Code). К примеру назвать функцию "Категория" и указать код внутри функции и сразу вышел результат.
- в листе 2 данные идут с пополнением (сейчас около 4000) и с каждым разом будет больше. Плюс столбцов больше по которым нужно установить пользовательскую функцию для вытягивания данных.
Надеюсь, что смог объяснить в правильной форме.

Сообщение отредактировал Аналитик2012 - Среда, 26.06.2019, 10:43

Дата: Среда, 26.06.2019, 10:26 | Сообщение № 4

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 236

Репутация: 29 ±

Замечаний: 20% ±

Excel 2010

Тема: Подтягивание дополнительных данных по событию ввода данных (ключа).
Аналитик2012, пользовательская функция так же будет тормозить - разницы не будет. Вам нужно использовать подтягивание данных по событию (ввода кода).

[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target.Count <> 1 Then Exit Sub
    If Target.Column = 2 And Target.Row > 5 Then
        If Not IsError(Application.VLookup(Target.Value, Sheets("Лист2").Range("B:C"), 2, 0)) Then
            Target.Offset(, 1).Value = Application.VLookup(Target.Value, Sheets("Лист2").Range("B:C"), 2, 0)
        Else
            Target.Offset(, 1).Value = "проверить код"
        End If
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

[/vba]

К сообщению приложен файл: 4566681.xlsm (16.8 Kb)

Сообщение отредактировал skais - Среда, 26.06.2019, 10:39

Дата: Среда, 26.06.2019, 10:33 | Сообщение № 5

Группа: Пользователи

Ранг: Участник

Сообщений: 53

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

skais, Спасибо большое. Только почему то при заполнении кода выходит рядом один результат "проверить код", хотя данная информация имеется в листе2. Можете пжл посмотреть

Сообщение отредактировал Аналитик2012 - Среда, 26.06.2019, 10:34

_Boroda_

Дата: Среда, 26.06.2019, 10:38 | Сообщение № 6

Группа: Админы

Ранг: Местный житель

Сообщений: 16718

Репутация: 6505 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

- Прочитайте Правила форума
- Оформите формулу тегами (в режиме правки поста выделите формулу и нажмите кнопку fx, пояснялка здесь)

skais, - Прочитайте Правила форумаЕсли вопрос задан с нарушением Правил - отвечать на него до исправления не нужно

Цитата skais, 26.06.2019 в 10:26, в сообщении № 4 ()

разницы не будет

Разница будет. Формула листа быстрее

Дата: Среда, 26.06.2019, 10:40 | Сообщение № 7

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 236

Репутация: 29 ±

Замечаний: 20% ±

Excel 2010

Аналитик2012, поправил.

Дата: Среда, 26.06.2019, 10:48 | Сообщение № 8

Группа: Пользователи

Ранг: Участник

Сообщений: 53

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

skais, Спасибо большое. Теперь работает, как нужно.
_Boroda_, подкорректировал формулу в теме.

Дата: Среда, 26.06.2019, 11:04 | Сообщение № 9

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 236

Репутация: 29 ±

Замечаний: 20% ±

Excel 2010

Boroda_ я в курсе на свой манер, потому и сразу тему предложил - это для исправления первого замечания.
А по второму, учитывая что автор прислушался к Вам, то второе замечание очевидно было, что исправит. То есть автор - порядочный.
Но учту!

Сообщение отредактировал skais - Среда, 26.06.2019, 11:19

_Boroda_

Дата: Среда, 26.06.2019, 11:34 | Сообщение № 10

Группа: Админы

Ранг: Местный житель

Сообщений: 16718

Репутация: 6505 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Цитата skais, 26.06.2019 в 11:04, в сообщении № 9 ()

я в курсе на свой манер

Ваш "манер", предположения и попытки объяснений совершенно неинтересны. Про помощь в темах с нарушениями Правил не раз уже писали и все уже давно обговорили.
Впрочем, как хотите. Я предупредил

Цитата _Boroda_, 26.06.2019 в 10:38, в сообщении № 6 ()

Если вопрос задан с нарушением Правил - отвечать на него до исправления не нужно

Дата: Среда, 26.06.2019, 11:51 | Сообщение № 11

Группа: Пользователи

Ранг: Участник

Сообщений: 53

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

skais,
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Count <> 1 Then Exit Sub
If Target.Column = 2 And Target.Row > 5 Then
If Not IsError(Application.VLookup(Target.Value, Sheets("Лист2").Range("B:C"), 2, 0)) Then
Target.Offset(, 1).Value = Application.VLookup(Target.Value, Sheets("Лист2").Range("B:C"), 2, 0)
Else
Target.Offset(, 1).Value = "проверить код"

If Not IsError(Application.VLookup(Target.Value, Sheets("Лист2").Range("B:D"), 3, 0)) Then
Target.Offset(, 2).Value = Application.VLookup(Target.Value, Sheets("Лист2").Range("B:C"), 3, 0)
Else
Target.Offset(, 2).Value = "проверить код"

End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

[/vba]

можете подсказать, что неправильно записал? Думал, что в тело потом включи еще те столбцы, которые должны заполняться, но не работает.

Сообщение отредактировал Аналитик2012 - Среда, 26.06.2019, 11:52

Дата: Среда, 26.06.2019, 13:02 | Сообщение № 12

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 236

Репутация: 29 ±

Замечаний: 20% ±

Excel 2010

в 12 строке неверно указан диапазон, нужно B:D!
и end if тоже не на своем месте.

[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Count <> 1 Then Exit Sub
If Target.Column = 2 And Target.Row > 5 Then
If Not IsError(Application.VLookup(Target.Value, Sheets("Лист2").Range("B:D"), 2, 0)) Then
     Target.Offset(, 1).Value = Application.VLookup(Target.Value, Sheets("Лист2").Range("B:D"), 2, 0)
     Target.Offset(, 2).Value = Application.VLookup(Target.Value, Sheets("Лист2").Range("B:D"), 3, 0)
Else
     Target.Offset(, 1).Value = "проверить код"
     Target.Offset(, 2).Value = "проверить код"
End If

Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

[/vba]

Сообщение отредактировал skais - Среда, 26.06.2019, 13:06

Дата: Среда, 26.06.2019, 13:10 | Сообщение № 13

Группа: Пользователи

Ранг: Участник

Сообщений: 53

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

skais, Спасибо большое еще раз.