Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Двойной клик по ячейке с вызывает выпадающий список с поиском с соответствующей сортировкой
 
#1
29.07.2021 08:58:53
Добрый день. Подскажите пожалуйста, как по двойному клику на листе "список" диапазона В3:В10000, появлялся диапазон по условию J3:J10000, с листа "Состав". То есть сделав двойной клик по ячейке B5 (Овощи), выводился перечень овощей с листа "Состав". После выбора которого данные вставлялись бы на лист "Список"
 
 
 
#2
29.07.2021 09:14:04
Станислав Вьюжанин,
думаю, это то, что Вам нужно
 
 
 
#3
29.07.2021 09:59:28
цитата - не бездумня копия [МОДЕРАТОР]

Спасибо "evgeniygeo". Я создавал многоуровневые выпадающие списки наименованными диапазонами с помощью ДВССЫЛ (INDIRECT) и формул. Добавил во вложение.
Но поскольку значений много порядка 10000 строк, хотелось бы реализовать с помощью макроса в виде двойного клика на ячейке и с поиском.
Пытался реализовать через vba. Пока не получается.
Код
    With Target  
          .Offset(, 1) = Price.Offset(, 1)
          .Offset(, 4) = Price.Offset(, 3)
          .Offset(, 6) = Price.Offset(, 5)
    End With
Изменено: vikttur - 29.07.2021 10:43:58
 
 
 
#4
29.07.2021 11:07:14
Станислав Вьюжанин,
все-таки я предлагаю сделать на формулах
Код
=СМЕЩ(Состав!$B$1;ПОИСКПОЗ(Список!$J2;Состав!$I:$I;0)-1;;СЧЁТЕСЛИМН(Состав!$I:$I;Список!$J2);1)
 
 
 
#5
29.07.2021 11:23:23
Станислав Вьюжанин, я не понял, что вы хотите и зачем двойной клик, если выпадающий список и так отображается в ячейках листа, но про события (а двойной клик это событие листа) можно почитать тут
Изменено: Jack Famous - 29.07.2021 11:24:17
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#6
29.07.2021 12:00:02
Я видел работу таблицы в таком формате. Двойным кликом меняем значение в столбце В3:В1000 листа "Список", но сейчас столбец В3:В1000 формируется выпадающим списком, а не двойным кликом.
Изменено: Станислав Вьюжанин - 29.07.2021 12:23:21 (Замечание админа)
 
 
 
#7
29.07.2021 15:50:46
Помогите пожалуйста заменить выпадающий список столбца b заменить  на вызов макроса по двойному клику, в формулы столбцов a,d,f на значения.
Изменено: Станислав Вьюжанин - 29.07.2021 16:33:00
 
 
 
#8
30.07.2021 06:12:37
Станислав Вьюжанин,
Не совсем понимаю, как Вы хотите чтобы выходил список? Нажали два раза мышкой и что должно произойти? Должна появится форма со списком (Listbox) или тот же самый выпадающий список (ТЫЦ)?
И объясните чем Вас не устраивает выпадающий список в моем примере?

Как вариант, для начала подтянуть данные других столбцов после изменения ячеек с выпадающим списком.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B:B")) Is Nothing Then

    Set fcell = Sheets("Состав").Columns("B:B").Find(ActiveCell)
    If Not fcell Is Nothing Then
        Cells(ActiveCell.Row, 1) = Sheets("Состав").Cells(fcell.Row, 1)
        Cells(ActiveCell.Row, 4) = Sheets("Состав").Cells(fcell.Row, 3)
        Cells(ActiveCell.Row, 6) = Sheets("Состав").Cells(fcell.Row, 5)
    End If

End If
End Sub
Изменено: evgeniygeo - 30.07.2021 07:09:03
 
 
 
#9
30.07.2021 10:33:38
Спасибо большое "evgeniygeo" за код, долго не мог разобраться как такое написать:
Код
    Set fcell = Sheets("Состав").Columns("B:B").Find(ActiveCell)
    If Not fcell Is Nothing Then
        Cells(ActiveCell.Row, 1) = Sheets("Состав").Cells(fcell.Row, 1)
        Cells(ActiveCell.Row, 4) = Sheets("Состав").Cells(fcell.Row, 3)
        Cells(ActiveCell.Row, 6) = Sheets("Состав").Cells(fcell.Row, 5)
    End If
. Касательно ваших вопросов: Не совсем понимаю, как Вы хотите чтобы выходил список? Нажали два раза мышкой и что должно произойти? Должна появится форма со списком (Listbox) или тот же самый выпадающий список (ТЫЦ)? хотелось бы видеть в виде выпадающего списка, но с поиском, что бы можно было искать по первым буквам.
И объясните чем Вас не устраивает выпадающий список в моем примере? выпадающий список очень хороший, но на последнем листе, данные с гитерссылками на веб сайты, а гиперссылки не перетаскиваются формулами, поэтому и хочу двойным кликом открывать одни данные, а если они выполнены то открывать другие данные. Для примера, при выбирании данных с ячейки B9 и ниже в выпадающем списке одни данные, а при изменении условия, например в B6 в выпадающем списке другие данны, но сделать их по условию пока не знаю как. Спасибо большое за помощь.
Изменено: Станислав Вьюжанин - 30.07.2021 10:37:09
 
 
 
#10
30.07.2021 11:04:51
Цитата
Станислав Вьюжанин: в виде выпадающего списка, но с поиском
Форма с поиском по маске. Как найти и получить одно или несколько значений
Изменено: Jack Famous - 30.07.2021 11:05:11
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#11
30.07.2021 16:27:36
Потрясающая форма, но я не смогу такую воссоздать (((
Я не понимаю как он данные поддаскивает из файла.
Могу предположить, что скорее всего через этот макрос:

Код
Private Sub bC_Click()
Dim arr(), x, i&, n&

ReDim arr(UBound(arrFull))

    For i = 0 To Me.lb.ListCount - 1
        If Me.lb.Selected(i) Then arr(n) = Me.lb.List(i): n = n + 1
    Next i

    If n = 0 Then
        If Me.lb.MultiSelect = fmMultiSelectSingle Then MsgBox "При вызове формы для одиночного выделения нельзя сформировать список из всего отфильтрованного!", vbExclamation, "ПУСТО": Exit Sub
        If MsgBox("Ничего не выбрано…" & vbLf & "Сформировать список из ВСЕГО ОТФИЛЬТРОВАННОГО" & vbLf & "(" & Me.lb.ListCount & " элементов)?", vbYesNo + vbQuestion + vbDefaultButton1) = vbNo Then Exit Sub
        ReDim arr(0 To UBound(arrFull)): n = 0
        For Each x In Me.lb.List
            arr(n) = x: n = n + 1
        Next x
    End If

fin: ReDim Preserve arr(n - 1): FS_arr = arr: Unload Me
End Sub


Наверно...
Изменено: Станислав Вьюжанин - 30.07.2021 16:30:16
 
 
 
#12
08.08.2021 19:23:25
Добрый день.
При отработке кода:
Код
        For Each rCell In Selection
        If rCell.Offset(-1, 0) <> "" And rCell.Offset(0, 38) <> "" And rCell.Offset(0, 39) <> "" Then rCell.Offset(1, 0).EntireRow.Insert
               rCell.Offset(1, 37) = "=R[-1]C" 'rCell.Offset(0, 37)
               'rCell.Offset(0, 38) = rCell.Offset(0, 38)
               rCell.Offset(1, 38) = rCell.Offset(0, 38)
               rCell.Offset(1, 39) = rCell.Offset(0, 39)
               rCell.Offset(1, 36) = "=R[-1]C"
               rCell.Offset(0, 21) = "да"
               rCell.Offset(1, 21) = "нет"
               rCell.Offset(0, 24) = "1"
               rCell.Offset(0, 26) = "1"
               rCell.Offset(0, 29) = "1"
        ElseIf rCell.Offset(0, 37) = "" And rCell.Offset(0, 38) = "" Then
               rCell.Offset(1, 0).EntireRow.Insert
               rCell.Offset(-1, 37) = rCell.Offset(-1, 0)
               rCell.Offset(0, 37) = rCell.Offset(-1, 0)
               rCell.Offset(0, 38) = "test"
               rCell.Offset(1, 37) = "=R[-1]C"
               rCell.Offset(1, 38) = rCell.Offset(0, 38)
               rCell.Offset(1, 39) = rCell.Offset(0, 39)
               rCell.Offset(1, 36) = "=R[-1]C"
               rCell.Offset(0, 21) = "да"
               rCell.Offset(1, 21) = "нет"
               rCell.Offset(0, 22) = "нет"
               rCell.Offset(0, 23) = "нет"
               rCell.Offset(0, 25) = "1"
               rCell.Offset(0, 29) = "1"
        Else '2
               rCell.Offset(0, 29) = "0"
        End If '2
        Next
Выдает ошибку:
Цитата
Else without if
с отсылкой на строку кода:
Код
 ElseIf rCell.Offset(0, 37) = "" And rCell.Offset(0, 38) = "" Then

Подскажите пожалуйста, где ошибка. Не могу найти.
Изменено: vikttur - 08.08.2021 19:51:38
 
 
 
#13
08.08.2021 19:30:57
Попробуйте в строке
Код
If rCell.Offset(-1, 0) <> "" And rCell.Offset(0, 38) <> "" And rCell.Offset(0, 39) <> "" Then rCell.Offset(1, 0).EntireRow.Insert

всё, что после Then, перенести на следующую строку.
Изменено: Юрий М - 08.08.2021 19:31:43
 
 
 
#14
08.08.2021 19:38:08
Спасибо Юрий, помогло.
 
 
 
#15
09.08.2021 08:17:30
Выбираем необходимые данные на листе "Список" желтый столбец.
Далее многоуровневым списком относит нас на лист материалы. Но данные с листа материалы не копируют гиперссылку, а так же не позволяют использовать поиск.
Помогите пожалуйста с многоуровневым списком.
Спасибо.
P.S. Что бы начать список заново, приходиться пропускать одну строку.
Изменено: Станислав Вьюжанин - 09.08.2021 09:47:23
 
 
 
#16
10.08.2021 07:35:24
По совету "Jack Famous" решил использовать предложенную им форму.
 
 
 
#17
10.08.2021 10:07:18
Цитата
Станислав Вьюжанин: как он данные поддаскивает из файла
там сложно
Получение массива уникальных из диапазона
Цитата
Станислав Вьюжанин: По совету "Jack Famous" решил использовать предложенную им форму
рад помочь  ;)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#18
11.08.2021 10:05:08
Щелкнул два раза на ячейке B11, Вызвал Listbox, но в нем все данные с листа материалы, а должны быть только данные из малярки: лак и краска.
Помогите пожалуйста отфильтровать список. Соответственно, когда нажимаю на ячейке В10 должны выводиться только данные Малярка, а остальных видно не должно быть.
Спасибо.
Изменено: Станислав Вьюжанин - 11.08.2021 10:06:51
 
 
 
#19
11.08.2021 10:11:10
Станислав Вьюжанин, моя форма работает в 3ёх режимах: фильтр текущего столбца, вставка значений из текущего столбца и вставка из пользовательского списка. Единственный режим, который вам тут может помочь - третий (вставка из своего списка) и всё, что остаётся, это, чтобы список менялся в зависимости от выбранных критериев. Иными словами - ссылаетесь всегда на один и тот же диапазон (можно динамический), а данные в нём меняете формулами или макросом

Вам остаётся создать тему "Как менять значения в списке в зависимости от выбранных параметров"
Изменено: Jack Famous - 11.08.2021 10:13:37
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
Страницы: 1
Наверх