Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1 2 След.
RSS
Формы. Как заполнять одну и ту же форму (ListBox) разными данными в зависимости от выделения
 
#1
04.05.2018 20:05:04
Доброго времени суток, Планетяне! Продолжаю разбираться с формами…

Вопрос вот в чём: есть у меня форма с поиском (вот такая). Работает она в разных диапазонах (вызывается по событию листа "перед даблкликом) - для каждого диапазона нужно передавать разные списки (обычно это массивы, бывают даже одномерные). Как это грамотно сделать?
Пробовал так, но ошибка
также пробовал манипуляции с объявлением переменных через Dim и Public в уровне проекта… Можно, конечно, задать форме динамический диапазон на листе, который будет очищаться и наполняться по событиям, но это костыли и очень топорный, как мне кажется, вариант.
Изменено: Jack Famous - 04.05.2018 20:07:31
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#2
04.05.2018 20:16:53
А вот так?
Код
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngGents As Range, rngLadies As Range
 
Set rngGents = [D3:F8]
Set rngLadies = [K5:M10]
 
If Not Intersect(Target, rngGents) Is Nothing Then: FormSearch.ListBoxItems.List = rngGents.value: FormSearch.Show
If Not Intersect(Target, rngLadies) Is Nothing Then: FormSearch.ListBoxItems.List = rngLadies.value: FormSearch.Show
End Sub

Хотя тут задается в качестве приемника вся коллекция листбоксов формы... Т.е. тоже будет ошибка.

Еще можно через Array задать список адресов диапазонов, и по этому списку загружать в листбоксы циклом.

Изменено: Anchoret - 04.05.2018 20:20:01
 
 
 
#3
04.05.2018 20:33:47
Вариантов решения данной проблемы множество.
Вот один из них.
P.S. Добавьте ещё закрытие на ESC, в таких формах это хорошая "плюшка".
Изменено: Alemox - 04.05.2018 20:35:25
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.
 
 
 
#4
04.05.2018 20:46:02
Anchoret, приветствую! Код вообще странный - заполнять ListBox пустым диапазоном или я чего-то не понимаю?… :)
Alemox, здравствуйте! Вот что-то такое я и искал - немного не допёр с переменными просто  :D  спасибо большое!  :idea:
Если будут вопросы, то отпишусь сюда  :)
Изменено: Jack Famous - 04.05.2018 20:46:12
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#5
04.05.2018 20:58:54
Jack Famous,файл не смотрел, поэтому что там в диапазоне - без понятия. Да, и код не мой, а немного измененный Ваш)
Варианты заполнения:
- listbox1.list=arr , т.е. массивом
- циклом с Add.Item
- задать в качестве источника заполнения диапазон на листе

Лично я загружаю массивом.
Вариант пакетной обработки контролов:
Код
aa = Array(1, 2, 3, 4)
For a = 1 To 4
  Me.Controls("Label" & a).Caption = aa(a - 1)
Next
Поэтому удобнее их стандартизировать по названиям.
 
 
 
#6
04.05.2018 21:06:54
Цитата
Anchoret написал:
что там в диапазоне
в именованных диапазонах как раз и были списки, с листов))
Цитата
Anchoret написал:
Варианты заполнения:
ну по ним я понял в общих чертах - проблема была именно в заполнении разными справочниками одной и той же формы. Чтобы поиск не сбить и так далее…
Цитата
Anchoret написал:
Лично я загружаю массивом
я тоже, но, когда массив одномерный, то быстро никак, (кроме штатного транспонирования, но оно ограничено). Циклами только.
Цитата
Anchoret написал:
Вариант пакетной обработки контролов
а вот тут я, пожалуй, без примера не разберусь - что это за зверь такой?  :D
спасибо!
Изменено: Jack Famous - 04.05.2018 21:07:08
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#7
04.05.2018 21:09:47
Цитата
Jack Famous написал:
без примера не разберусь
Так там пример и есть) Экстраполируйте на любые другие элементы формы с учетом их особенностей.
 
 
 
#8
04.05.2018 21:12:33
Anchoret, хорошо - попробую припаять ;)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#9
05.05.2018 13:08:35
И ещё по поводу циклов:
Код
    For Each x In arrFull
        itxt = "*" & UCase(Me.TextBoxItems.Value) & "*"
        If UCase(x) Like itxt Then Me.ListBoxItems.AddItem x
    Next x
Это хорошо когда у вас немного позиций, но если их количество достигает 50000 и больше, то тут получится очень медленно. Процесс заполнения AddItem замедляет выполнение макроса. Недавно такой код преобразовывал. Скорость обработки и поиска увеличилась в 4 раза. Если такая проблема есть. То лучше заносите данные в цикле в массив, а потом полученный массив уже одним присвоением в ListBox.
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.
 
 
 
#10
05.05.2018 18:28:46
Alemox, пока таких объёмов нет, но тоже уже подумал над этим… Ваш вариант даже не рассматривал, а зря — просто и очень логично!  :idea:  Хочу также попробовать сделать, применяя вот этот способ (через Like) - до сих пор восхищаюсь его скоростью. Есть проблема с наличием служебных символов в проверяемой текстовой строке (типа, они там должны быть) - решено с помощью отдельной функции, преобразовывающей их в тэги типа "?"="vopr", "*"="zvezd" и так далее  :D
спасибо вам!
Изменено: Jack Famous - 05.05.2018 18:30:51
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#11
11.05.2018 15:57:44
Доброго времени суток, Планетяне!

Господа! Пытаюсь по совету Alemox, по событию изменения текстбокса, сначала наполнять массив, чтобы потом махом его присвоить, но что-то не выходит. И с размерностями игрался (по идее, раз массив с листа подходит, то создаваемый тоже должен быть двумерный с 1 столбцом…), и так, и сяк  :( в чём проблема?
Код
Private Sub TextBoxItems_Change()
Dim x, i&, itxt$, arrFill()

Me.ListBoxItems.Clear
    For Each x In arrForm
        itxt = "*" & UCase(Me.TextBoxItems.Value) & "*"
'        If UCase(x) Like itxt Then Me.ListBoxItems.AddItem x
        If UCase(x) Like itxt Then i = i + 1: ReDim Preserve arrFill(i, 1): arrFill(i, 1) = x
    Next x
ListBoxItems.List = arrFill()
End Sub
Изменено: Jack Famous - 11.05.2018 15:59:53
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#12
11.05.2018 16:07:09
Код
If UCase(x) Like itxt Then i = i + 1: ReDim Preserve arrFill(i): arrFill(i) = x

массив же одномерный, а да и пресервить можно только последнюю размерность

Изменено: yozhik - 11.05.2018 16:08:04
 
 
 
#13
11.05.2018 16:23:20
yozhik, спасибо вам! Только на рабочем файле (не примере) почему-то не срабатывает — буду разбираться.
Странно, что для списка подходит и двумерный массив (массив с листа) и одномерный…  :D

UPD: теперь и в примере ошибка 380. Может я не массивом загонял, когда сказал, что всё норм…
Всё - я понял. Ошибка была, если по like ничего не подходило с первого символа. А насчёт размерностей - в этом случае действительно подходит только одномерный. Запомню насчёт редима  ;)
Вот как выглядит код теперь, со всеми проверками и индексом одномерного массива с 0:
Код
Private Sub TextBoxItems_Change()
Dim x, i&, txt$, arrFill()
Me.ListBoxItems.Clear
    For Each x In arrFormSearch
        txt = "*" & UCase(Me.TextBoxItems.Value) & "*"
        If UCase(x) Like txt Then ReDim Preserve arrFill(i): arrFill(i) = x: i = i + 1
    Next x
If Not PRDX_ArrayFull(arrFill) Then Me.ListBoxItems.Clear Else: Me.ListBoxItems.List = arrFill
End Sub
'=============================================================
Public Function PRDX_ArrayFull(WF_arr As Variant) As Boolean
On Error Resume Next
PRDX_ArrayFull = LBound(WF_arr) <= UBound(WF_arr)
End Function


Спасибо вам ещё раз за решение и объяснение!
Изменено: Jack Famous - 11.05.2018 16:52:25
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#14
11.05.2018 17:02:54
Jack Famous, чтобы что-то Preserv'ить нужно это что-то инициировать - ReDim arrFill(0) перед циклом.
 
 
 
#15
11.05.2018 17:26:38
Anchoret, массив же уже объявлен как динамический… Зачем такие движения? Я не в курсе.
Если вы про то, что пресерв сохраняет значения (которых до начала цикла нет), то, теоретически, пресервить для i=0 смысла нет  можно и простым редимом обойтись. Но это лишняя запись и так ли она нужна? То есть, можно ли без неё схлопотать ошибку?
Изменено: Jack Famous - 11.05.2018 17:29:33
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#16
11.05.2018 22:10:49
Если интересно, то вот передача параметров через процедуру. Можно Range, можно Array, и всякая всячина, поиск(и), сортировка, изменяемые размеры.
Просто очень долго описание делать, а если будут вопросы, то отвечу. Я из этой формы делаю, типа, меню в разных проектах, поэтому ее можно считать болванкой.
В данном файле запуск правой кнопкой.
P.S.
На время отладки/экспериментов MouseWheelResolution устанавливать False, иначе при любой ошибке при инициализированном MouseScroll завешивает Excel напрочь. Останется только снять задачу.
P.S.
Прошу прощения, перезалил и пронумеровал версию, а то я запутался в своих фантазиях и промежуточную версию дал... :)
Изменено: AAF - 12.05.2018 00:00:22
 
 
 
#17
11.05.2018 23:35:13
AAF, спасибо вам! Попробую разобраться)

UPD: мощная штука 8-0  :idea: . Надо классы изучать, а то я в них ни бум-бум  :D
Изменено: Jack Famous - 11.05.2018 23:39:19
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#18
12.05.2018 00:03:19
Цитата
Jack Famous написал:
Надо классы изучать
И они окажутся неожиданно простыми в реализации, как ни странно...
 
 
 
#19
12.05.2018 00:06:06
AAF, посоветуете что-нибудь?) видео, литература…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#20
12.05.2018 00:11:47
Посмотрите на дату моей регистрации. Тогда я еще не знал как правильно использовать эти классы.
Все полученное мной находится в пределах нашей планеты и MSDN.
Я попробую вспомнить где подцепил необходимую инфу, но это были не системные познания и литературу я не читал.
Чьи то примеры и мои эксперименты... :)
Наверно проще создать тему, а я с удовольствием отвечу интересующимся...
Вот как-то помню смотрел и вполне достаточно для общего понимания, тем более что классы в VBA, в основном для этого (как описал Дима в примере) и применяются, ибо нормального наследования все равно нет.
https://www.excel-vba.ru/chto-umeet-excel/rabota-s-modulyami-klassov/
Изменено: AAF - 12.05.2018 01:11:05
 
 
 
#21
12.05.2018 00:18:40
Цитата
AAF написал:
Наверное проще создать тему
и это будет правильнее — спасибо!  :idea:
в понедельник сделаю, если опять не влезу в проект какой-нибудь   :D
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#22
12.05.2018 09:19:50
Jack Famous, а ведь точно, с одномеркой и если нет Option Base такой вариант прокатывает. :) Но с двумерным и массивом прочей размерности такой финт ушами не пройдет.
Изменено: Anchoret - 12.05.2018 09:21:38
 
 
 
#23
12.05.2018 10:02:52
Anchoret, что-то я так и не понял в чем проблема... Наверно я не о том думаю... :(

Код
'Option Compare Text 'если всегда регистро-независимый поиск, чтоб убрать UCase и будет быстрей

Private Sub TextBoxItems_Change()
Dim x, i&, txt$, arrFill()
Me.ListBoxItems.Clear
txt = "*" & UCase(Me.TextBoxItems.Value) & "*" 'не было смысла засовывать это в цикл, а если список на 1 000 000
i = LBound(arrFormSearch): ReDim arrFill(i To UBound(arrFormSearch)) 'чтоб не зависеть от Option Base
For Each x In arrFormSearch
  If UCase(x) Like txt Then arrFill(i) = x: i = i + 1
Next 
'ReDim Preserve занимает время, поэтому, по возможности, это лучше делать 1 раз
If i > LBound(arrFormSearch) Then ReDim Preserve arrFill(LBound(arrFormSearch) To i - 1): Me.ListBoxItems.List = arrFill Else Erase arrFill
End Sub
 
 
 
#24
12.05.2018 10:05:51
AAF, приветствую) Да нет проблемы. Был небольшой спор касательно ReDim Preserve без предварительного ReDim'а массива.
 
 
 
#25
12.05.2018 10:10:08
Цитата
Jack Famous написал:
Хочу также попробовать сделать, применяя  вот этот  способ (через Like) - до сих пор восхищаюсь его скоростью
Like сам по себе медленный. А если еще и надо не учитывать служебные символы звезды и вопр.знака - то как пить дать надо заменить на InStr. В примере приводится такая строка:
Код
If "%" & Join(массив, "%") & "%" Like "*%" & ИскомаяПодстрока & "%*" Then

вот она как раз просто обязана быть заменена на такую:
Код
If InStr(1, "%" & Join(массив, "%") & "%", "%" & ИскомаяПодстрока & "%", 1) <> 0 Then
и это будет к тому же быстрее. И регистр не учитывается(хотя, если поиграться последним параметром, то можно и регистрозависимую проверку сделать)
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#26
12.05.2018 10:26:35
Anchoret, а так разве не работает?
Код
'Option Base 1
Sub ReDimPreserveБезПредварительногоReDim ()
Dim a(), b(), c()
ReDim Preserve a(1 To 20)
ReDim Preserve b(10 To 20, -10 To 3)
ReDim Preserve c(20, -10 To 3, -5 To -3)
End Sub
 
 
 
#27
12.05.2018 10:42:55
Сократим?
Код
Sub ReDimPreserveБезПредварительногоReDim()
Dim a(), b(), c()
ReDim Preserve a(1 To 20), b(10 To 20, -10 To 3), c(20, -10 To 3, -5 To -3)
End Sub
или чуть более наглядно:
Код
Sub ReDimPreserveБезПредварительногоReDim()
Dim a(), b(), c()
ReDim Preserve a(1 To 20), _
               b(10 To 20, -10 To 3), _
               c(20, -10 To 3, -5 To -3)
End Sub
Изменено: Дмитрий Щербаков - 12.05.2018 10:43:33
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#28
12.05.2018 10:45:39
Дмитрий Щербаков, Без переноса было лучше   8)
 
 
 
#29
12.05.2018 10:46:37
Jack Famous обладает уникальной спосбностью - практически каждая его тема (а часто и тема с его участием) уходит далеко в сторону.
 
 
 
#30
12.05.2018 11:26:02
Цитата
AAF написал:
Без переноса было лучше
ну тут уж каждому на свой вкус. Зависит еще и от кол-ва таких массивов. В данном конкретном случае мне без переноса тоже больше нравится, но иногда делаю так именно для наглядности(когда код большой, то ориентироваться по нему чуть удобнее).
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
Страницы: 1 2 След.
Наверх