Excel двойное нажатие на ячейку

Прикрепленные файлы

цитата — не бездумня копия [МОДЕРАТОР]

Спасибо «

evgeniygeo

«. Я создавал многоуровневые выпадающие списки наименованными диапазонами с помощью ДВССЫЛ (INDIRECT) и формул. Добавил во вложение.
Но поскольку значений много порядка 10000 строк, хотелось бы реализовать с помощью макроса в виде двойного клика на ячейке и с поиском.
Пытался реализовать через vba. Пока не получается.

    With Target  
          .Offset(, 1) = Price.Offset(, 1)
          .Offset(, 4) = Price.Offset(, 3)
          .Offset(, 6) = Price.Offset(, 5)
    End With

Прикрепленные файлы

Станислав Вьюжанин,
все-таки я предлагаю сделать на формулах

=СМЕЩ(Состав!$B$1;ПОИСКПОЗ(Список!$J2;Состав!$I:$I;0)-1;;СЧЁТЕСЛИМН(Состав!$I:$I;Список!$J2);1)

Прикрепленные файлы

Станислав Вьюжанин, я не понял, что вы хотите и зачем двойной клик, если выпадающий список и так отображается в ячейках листа, но про события (а двойной клик это событие листа) можно почитать

тут

Изменено: Jack Famous — 29.07.2021 11:24:17

Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄

Прикрепленные файлы

Изменено: Станислав Вьюжанин — 29.07.2021 12:23:21
(Замечание админа)

Прикрепленные файлы

Изменено: Станислав Вьюжанин — 29.07.2021 16:33:00

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

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» за код, долго не мог разобраться как такое написать:

    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

Форма с поиском по маске. Как найти и получить одно или несколько значений

Изменено: Jack Famous — 30.07.2021 11:05:11

Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄

Потрясающая форма, но я не смогу такую воссоздать (((
Я не понимаю как он данные поддаскивает из файла.
Могу предположить, что скорее всего через этот макрос:

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

Добрый день.
При отработке кода:

        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

Выдает ошибку:

с отсылкой на строку кода:

 ElseIf rCell.Offset(0, 37) = "" And rCell.Offset(0, 38) = "" Then

Подскажите пожалуйста, где ошибка. Не могу найти.

Попробуйте в строке

If rCell.Offset(-1, 0) <> "" And rCell.Offset(0, 38) <> "" And rCell.Offset(0, 39) <> "" Then rCell.Offset(1, 0).EntireRow.Insert

всё, что после Then, перенести на следующую строку.

Прикрепленные файлы

Изменено: Станислав Вьюжанин — 09.08.2021 09:47:23

там сложно

рад помочь  

Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄

Изменено: Станислав Вьюжанин — 11.08.2021 10:06:51

Станислав Вьюжанин, моя форма работает в 3ёх режимах: фильтр текущего столбца, вставка значений из текущего столбца и вставка из пользовательского списка. Единственный режим, который вам тут может помочь — третий (вставка из своего списка) и всё, что остаётся, это, чтобы список менялся в зависимости от выбранных критериев. Иными словами — ссылаетесь всегда на один и тот же диапазон (можно динамический), а данные в нём меняете формулами или макросом

Вам остаётся создать тему «Как менять значения в списке в зависимости от выбранных параметров»

Изменено: Jack Famous — 11.08.2021 10:13:37

Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄