Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

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

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


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 25 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

Ответ
 
Опции темы
Старый 22.08.2019, 15:12   #1
Zaris
 
Регистрация: 14.08.2019
Сообщений: 8
Репутация: 10
По умолчанию Кастомный ВПР с помощью функции

Всем привет. Имеется следующий файл:
https://i.imgur.com/WmLw2Um.png
Состоит из "Основного" и любого количества листов "Товары", в которых хранится код из базы, цена и наличие, которое указано в название листа в скобках (например, Товары 1 (3))
https://i.imgur.com/3RmmL9m.png
https://i.imgur.com/IZGbotf.png
Шаги следующие:
1) В лист "Основной" в 4 столбец вставляем формулу и проводим на все ячейки этого столбца:
=ВПР(RC[-2];'Товары 1 (3)'!R1C1:R3C2;2;0)
https://i.imgur.com/pfdWnTJ.png
2) Фильтруем по значению "Все, кроме Н/Д" и в соседний столбец ставим значение из этого столбца, а в 13 столбец "Наличие" ставим то значение, которое указано в названии текущего листа в скобках, снимаем фильтр:
https://i.imgur.com/a4z1iCi.png
3) Копируем и вставляем 5 столбец как значение, затем очищаем 4 столбец:
https://i.imgur.com/soGnhWs.png
Этот блок завершен, данные с первого листа подтянули в основной через впр, поставив в нужный код из базы нужные цены и наличие.
Следующий блок начнется если есть следующий лист с товарами:
4) В лист "Основной" в 4 столбец вставляем формулу и проводим на все ячейки этого столбца:
=ВПР(RC[-2];'Товары 2 (+)'!R1C1:R6C2;2;0)
https://i.imgur.com/hhiDuEU.png
5) Фильтруем по значению "Все, кроме Н/Д" и в соседний столбец ставим значение из этого столбца, а в 13 столбец "Наличие" ставим то значение, которое указано в названии текущего листа в скобках, снимаем фильтр:
https://i.imgur.com/vd1hglk.png
На данном шаге встретилось первое совпадение:
Товары 1 (3) 14996 45990
Товары 2 (+) 14996 44990
В данном случае цена перезаписывается с 45990 на 44990, наличие с 3 на +
6) Копируем и вставляем 5 столбец как значение, затем очищаем 4 столбец:
https://i.imgur.com/nsMy1P7.png


Я для начала создал функцию с 3 параметрами:
Код:
Function CustomVPR(Code As Range, CurrentList As Object, Stock As Range)

End Function
На этом этапе в переменную CurrentList у меня не получается сохранить выбранный лист, требует указывать еще и столбцы:
https://i.imgur.com/LEMswzZ.png

1) Как хранить ссылку на выбранный лист?
2) Можно ли сделать функцию, которая сама будет перебирать листы с "Товар 1 (N)" до "Товар X (N)", N-что нужно подставить в 13 столбец наличие, а X-количество листов.
3) Если это сделать трудно, то ручной вариант с перебором этой функции тоже подойдет.
Подскажите, с чего начать? Спасибо
Вложения
Тип файла: xlsx пример.xlsx (10.6 Кб, 10 просмотров)

Последний раз редактировалось Zaris; 22.08.2019 в 16:45.
Zaris вне форума   Ответить с цитированием
Старый 22.08.2019, 15:48   #2
IgorGO
МегаМодератор
СуперМодератор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Адрес: УКРАЇНА, Київ
Сообщений: 9,174
Репутация: 1811

icq: 7934250
skype: i2x0,5
По умолчанию

начните с того, что опишите задачу, которую решаете, а не способ которым Вы пытаетесь ее решить
__________________
41001804815208 - Яндекс-деньги благодарности за удачные советы и решения можно отправлять прямо сюда)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума   Ответить с цитированием
Старый 22.08.2019, 16:54   #3
Zaris
 
Регистрация: 14.08.2019
Сообщений: 8
Репутация: 10
По умолчанию

Цитата:
Сообщение от IgorGO Посмотреть сообщение
начните с того, что опишите задачу, которую решаете, а не способ которым Вы пытаетесь ее решить
Задача: из всей базы отобрать позиции на сегодня, которые есть на дополнительных листах (формируются извне)
Zaris вне форума   Ответить с цитированием
Старый 22.08.2019, 17:22   #4
IgorGO
МегаМодератор
СуперМодератор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Адрес: УКРАЇНА, Київ
Сообщений: 9,174
Репутация: 1811

icq: 7934250
skype: i2x0,5
По умолчанию

см.вложение
Вложения
Тип файла: zip пример (40).zip (18.6 Кб, 12 просмотров)
__________________
41001804815208 - Яндекс-деньги благодарности за удачные советы и решения можно отправлять прямо сюда)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума   Ответить с цитированием
Старый 26.08.2019, 10:42   #5
Zaris
 
Регистрация: 14.08.2019
Сообщений: 8
Репутация: 10
По умолчанию

Цитата:
Сообщение от IgorGO Посмотреть сообщение
см.вложение
все отлично, спасибо, немного допилил (в 13 столбец теперь подставляются значения между скобок в названии листа, пишется время выполнения скрипта и скрипт останавливается, если видит лист с названием (...)). В итоге вышло вот это:
Код:
Sub FindAll()
 Dim sglStart As Single, w&, r&, name, stock As String, final As Object, objRegExp As Object, rg As Range, a
 sglStart = Timer
 Range("E2:E" & Rows.Count).Clear
 Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Pattern = "\((.+?)\)"
    
 For w = 3 To Worksheets.Count
    With Worksheets(w)
     name = Worksheets(w).name
     Set final = objRegExp.Execute(name)
     stock = final(0).SubMatches(0)
     a = .[a1].CurrentRegion
     If (name = "(...)") Then
        Exit For
     End If
     For r = 1 To UBound(a)
       Set rg = Worksheets(1).Columns(2).Find(a(r, 1), , xlValues, xlWhole, searchformat:=False)
       If (Not rg Is Nothing) Then
        rg.Offset(, 3) = a(r, 2)
        rg.Offset(, 11) = stock
       End If
     Next
   End With
 Next
MsgBox Timer - sglStart
End Sub
Скрипт работает очень хорошо, но при больших объемах висит намертво (45k позиций на основном листе, и в среднем по 15k на остальных). Процессор загружается в среднем на 30%, оперативы тратиться немного, но скрипт так и не завершается. Я с vba дело не имел, я так понимаю нужно как-то очищать память от переполнения. В чем может быть причина?
Zaris вне форума   Ответить с цитированием
Старый 26.08.2019, 12:12   #6
Serge_Bliznykov
МегаМодератор
СуперМодератор
 
Регистрация: 09.01.2008
Сообщений: 25,847
Репутация: 5617
По умолчанию

как я понимаю, в первом листе в столбце B список во время работы не меняется?

Тогда я бы рекомендовал заменить поиск Find на поиск в словаре (см. https://www.planetaexcel.ru/forum/in...#message399225).
Один раз считать данные из столбца в память и дальше использовать его.
Serge_Bliznykov вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Вычисление функции с использованием разложения в ряд Вычислить и вывести на экран в виде таблицы значения функции, заданной с помощью ряда Тейлора, maximk301 Помощь студентам 1 20.10.2018 17:20
Составить программу для приближенного вычисления значения функции в точке х с помощью разложения в ряд Тейлора. Найти приближенное значение функции с погрешностью менее 0,0001. marysluva Помощь студентам 1 18.12.2016 19:13
Wp кастомный текстовый дамп garry1989 WordPress и другие CMS 0 25.06.2015 15:15
Кастомный интерфейс Начинающий_кодер C++ Builder 1 15.02.2015 14:08


09:40.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.