Выпадающие списки в excel с помощью vba

По умолчанию вы можете выбрать только один элемент в раскрывающемся списке проверки данных в Excel. Как вы можете сделать несколько вариантов выбора в раскрывающемся списке, как показано ниже? Методы, описанные в этой статье, могут помочь вам решить проблему.

Создать раскрывающийся список с несколькими вариантами выбора с кодом VBA

В этом разделе представлены два кода VBA, которые помогут вам сделать множественный выбор в раскрывающихся списках на листе. Два кода VBA могут достичь:

Вы можете применить один из следующих кодов VBA, чтобы сделать несколько выборов в раскрывающемся списке на листе в Excel. Пожалуйста, сделайте следующее.

1. Откройте рабочий лист, содержащий раскрывающиеся списки проверки данных, из которых вы хотите сделать несколько выборов. Щелкните правой кнопкой мыши вкладку листа и выберите Просмотреть код из контекстного меню.

2. в Microsoft Visual Basic для приложений окно, скопируйте приведенный ниже код VBA в окно кода. Смотрите скриншот:

Код VBA 1: разрешить множественный выбор в раскрывающемся списке без дубликатов

Private Sub Worksheet_Change(ByVal Target As Range)
    'Updated by Extendoffice 2019/11/13
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    If Target.Count > 1 Then Exit Sub
    On Error Resume Next
    Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
    If xRng Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If Not Application.Intersect(Target, xRng) Is Nothing Then
        xValue2 = Target.Value
        Application.Undo
        xValue1 = Target.Value
        Target.Value = xValue2
        If xValue1 <> "" Then
            If xValue2 <> "" Then
                If xValue1 = xValue2 Or _
                   InStr(1, xValue1, ", " & xValue2) Or _
                   InStr(1, xValue1, xValue2 & ",") Then
                    Target.Value = xValue1
                Else
                    Target.Value = xValue1 & ", " & xValue2
                End If
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

3. нажмите другой + Q ключи, чтобы закрыть Microsoft Visual Basic для приложений окно.

Теперь вы можете выбрать несколько элементов из раскрывающегося списка на текущем листе.

Предположим, вы случайно выбрали элемент и вам нужно удалить его, не очищая всю ячейку и не начиная заново. Следующий код VBA 2 может оказать вам услугу.

Код VBA 2: разрешить множественный выбор в раскрывающемся списке без дубликатов (удалить существующие элементы, выбрав его снова)

Private Sub Worksheet_Change(ByVal Target As Range)
    'Updated by Extendoffice 2023/01/11
    'Updated by Ken Gardner 2022/07/11
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    Dim semiColonCnt As Integer
    Dim xType As Integer
    If Target.Count > 1 Then Exit Sub
    On Error Resume Next
    
    xType = 0
    xType = Target.Validation.Type
    If xType = 3 Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        xValue2 = Target.Value
        Application.Undo
        xValue1 = Target.Value
        Target.Value = xValue2
        If xValue1 <> "" Then
            If xValue2 <> "" Then
                If xValue1 = xValue2 Or xValue1 = xValue2 & ";" Or xValue1 = xValue2 & "; " Then ' leave the value if only one in list
                    xValue1 = Replace(xValue1, "; ", "")
                    xValue1 = Replace(xValue1, ";", "")
                    Target.Value = xValue1
                ElseIf InStr(1, xValue1, "; " & xValue2) Then
                    xValue1 = Replace(xValue1, xValue2, "") ' removes existing value from the list on repeat selection
                    Target.Value = xValue1
                ElseIf InStr(1, xValue1, xValue2 & ";") Then
                    xValue1 = Replace(xValue1, xValue2, "")
                    Target.Value = xValue1
                Else
                    Target.Value = xValue1 & "; " & xValue2
                End If
                Target.Value = Replace(Target.Value, ";;", ";")
                Target.Value = Replace(Target.Value, "; ;", ";")
                If Target.Value <> "" Then
                    If Right(Target.Value, 2) = "; " Then
                        Target.Value = Left(Target.Value, Len(Target.Value) - 2)
                    End If
                End If
                If InStr(1, Target.Value, "; ") = 1 Then ' check for ; as first character and remove it
                    Target.Value = Replace(Target.Value, "; ", "", 1, 1)
                End If
                If InStr(1, Target.Value, ";") = 1 Then
                    Target.Value = Replace(Target.Value, ";", "", 1, 1)
                End If
                semiColonCnt = 0
                For i = 1 To Len(Target.Value)
                    If InStr(i, Target.Value, ";") Then
                        semiColonCnt = semiColonCnt + 1
                    End If
                Next i
                If semiColonCnt = 1 Then ' remove ; if last character
                    Target.Value = Replace(Target.Value, "; ", "")
                    Target.Value = Replace(Target.Value, ";", "")
                End If
            End If
        End If
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

Заметки:

Легко создавайте раскрывающийся список с несколькими вариантами выбора с помощью замечательного инструмента

Здесь мы настоятельно рекомендуем Раскрывающийся список с множественным выбором особенность Kutools for Excel для вас. С помощью этой функции вы можете легко выбрать несколько элементов из раскрывающегося списка в указанном диапазоне, текущем листе, текущей книге или всех открытых книгах по мере необходимости.

1. Нажмите Кутулс > Раскрывающийся список > Раскрывающийся список с множественным выбором > Настройки. Смотрите скриншот:

2. в Настройки раскрывающегося списка с множественным выбором диалоговое окно, настройте следующим образом.

• 2.1) Укажите область применения в Обращаться к раздел. В этом случае я выбираю Текущий рабочий лист из Указанный объем раскрывающийся список;
• 2.2). Направление текста раздел выберите направление текста в зависимости от ваших потребностей;
• 2.3). Разделитель поле введите разделитель, который вы будете использовать для разделения нескольких значений;
• 2.4) Проверьте Не добавляйте дубликаты коробка в Опции раздел, если вы не хотите дублировать ячейки выпадающего списка;
• 2.5) Нажмите OK кнопка. Смотрите скриншот:

3. Щелкните Кутулс > Раскрывающийся список > Раскрывающийся список с множественным выбором для включения функции.

Теперь вы можете выбрать несколько элементов из раскрывающегося списка на текущем листе или в любой области, указанной на шаге 2.

  Если вы хотите получить бесплатную пробную версию (30-день) этой утилиты, пожалуйста, нажмите, чтобы загрузить это, а затем перейдите к применению операции в соответствии с указанными выше шагами.

Статьи по теме:

Ребят, а может мне кто-нибудь подскажет вариант реализации? Задача у меня такая: есть файл с адресами: Город, Улица, Дом — это столбцы. Файл для каждого региона свой, и он динамичный лежит в общем справочнике. Мы работаем с другим файлом, в который вставляется нужный листик, в зависимости от того, какой регион его открывает. Это я написала. Так вот… теперь надо, чтобы на другом листочке в столбцах Город/улица/дом, выходили выпадающие списки, причём для определённого города, только его улицы, а для улиц дома… При этом не должно быть пустых и улицы уникальны.

Я придумала два варианта реализации… Но они оба не отличаются особым успехом.

Первый: почти без VBA

с помощью VBA я создаю уникальный список городов и делаю его именем и прописываю кодом, что значение в столбце должно быть список с именем «Город»

далее, так как у меня есть список Город-Улица (на адресном листе), с помощью формулы смещения и поиска позиции нахожу улицы только этого города.(минус этого такой, что эта формула в именах постоянно почему-то (!) сбивается…)

Далее аналогично, этой же формулой нахожу дома для улиц.

Второй способ — не осуществила до конца, так как ступор… Создала уникальные города на отдельном листе в строку… Далее создала под каждым городом его улицы — так же уникальные… А вот теперь надо через ДВССЫЛ через VBA создать столько имён, сколько у меня вышло городов…. вообщем как это сделать…. если это реально…

Если есть другой вариант решения очень жду!!

Заранее спасибо

based on examples above and examples found on other sites, I created a generic procedure and some examples.

'Simple helper procedure to create a dropdown in a cell based on a list of values in a range
'ValueSheetName : the name of the sheet containing the value range
'ValueRangeString : the range on the sheet with name ValueSheetName containing the values for the dropdown
'CreateOnSheetName : the name of the sheet where the dropdown needs to be created
'CreateInRangeString : the range where the dropdown needs to be created
'FieldName As String : a name of the dropdown, will be used in the inputMessage and ErrorMessage
'See example below ExampleCreateDropDown
Public Sub CreateDropDown(ValueSheetName As String, ValueRangeString As String, CreateOnSheetName As String, CreateInRangeString As String, FieldName As String)
    Dim ValueSheet As Worksheet
    Set ValueSheet = Worksheets(ValueSheetName) 'The sheet containing the values
    Dim ValueRange As Range: Set ValueRange = ValueSheet.Range(ValueRangeString) 'The range containing the values
    Dim CreateOnSheet As Worksheet
    Set CreateOnSheet = Worksheets(CreateOnSheetName) 'The sheet containing the values
    Dim CreateInRange As Range: Set CreateInRange = CreateOnSheet.Range(CreateInRangeString)
    Dim InputTitle As String:  InputTitle = "Please Select a Value"
    Dim InputMessage As String:  InputMessage = "for " & FieldName
    Dim ErrorTitle As String:  ErrorTitle = "Please Select a Value"
    Dim ErrorMessage As String:  ErrorMessage = "for " & FieldName
    Dim ShowInput As Boolean:  ShowInput = True 'Show input message on hover
    Dim ShowError As Boolean:  ShowError = True 'Show error message on error
    Dim ValidationType As XlDVType:  ValidationType = xlValidateList
    Dim ValidationAlertStyle As XlDVAlertStyle:  ValidationAlertStyle = xlValidAlertStop 'Stop on invalid value
    Dim ValidationOperator As XlFormatConditionOperator:  ValidationOperator = xlEqual 'Value must be equal to one of the Values from the ValidationFormula1
    Dim ValidationFormula1 As Variant:  ValidationFormula1 = "=" & ValueSheetName & "!" & ValueRange.Address 'Formula referencing the values from the ValueRange
    Dim ValidationFormula2 As Variant:  ValidationFormula2 = ""

    Call CreateDropDownWithValidationInCell(CreateInRange, InputTitle, InputMessage, ErrorTitle, ErrorMessage, ShowInput, ShowError, ValidationType, ValidationAlertStyle, ValidationOperator, ValidationFormula1, ValidationFormula2)
End Sub


'An example using the ExampleCreateDropDown
Private Sub ExampleCreateDropDown()
    Call CreateDropDown(ValueSheetName:="Test", ValueRangeString:="C1:C5", CreateOnSheetName:="Test", CreateInRangeString:="B1", FieldName:="test2")
End Sub


'The full option function if you need more configurable options
'To create a dropdown in a cell based on a list of values in a range
'Validation: https://msdn.microsoft.com/en-us/library/office/ff840078.aspx
'ValidationTypes: XlDVType  https://msdn.microsoft.com/en-us/library/office/ff840715.aspx
'ValidationAlertStyle:  XlDVAlertStyle  https://msdn.microsoft.com/en-us/library/office/ff841223.aspx
'XlFormatConditionOperator  https://msdn.microsoft.com/en-us/library/office/ff840923.aspx
'See example below ExampleCreateDropDownWithValidationInCell
Public Sub CreateDropDownWithValidationInCell(CreateInRange As Range, _
                                        Optional InputTitle As String = "", _
                                        Optional InputMessage As String = "", _
                                        Optional ErrorTitle As String = "", _
                                        Optional ErrorMessage As String = "", _
                                        Optional ShowInput As Boolean = True, _
                                        Optional ShowError As Boolean = True, _
                                        Optional ValidationType As XlDVType = xlValidateList, _
                                        Optional ValidationAlertStyle As XlDVAlertStyle = xlValidAlertStop, _
                                        Optional ValidationOperator As XlFormatConditionOperator = xlEqual, _
                                        Optional ValidationFormula1 As Variant = "", _
                                        Optional ValidationFormula2 As Variant = "")

    With CreateInRange.Validation
        .Delete
        .Add Type:=ValidationType, AlertStyle:=ValidationAlertStyle, Operator:=ValidationOperator, Formula1:=ValidationFormula1, Formula2:=ValidationFormula2
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = InputTitle
        .ErrorTitle = ErrorTitle
        .InputMessage = InputMessage
        .ErrorMessage = ErrorMessage
        .ShowInput = ShowInput
        .ShowError = ShowError
    End With
End Sub


'An example using the CreateDropDownWithValidationInCell
Private Sub ExampleCreateDropDownWithValidationInCell()
    Dim ValueSheetName As String: ValueSheetName = "Hidden" 'The sheet containing the values
    Dim ValueRangeString As String: ValueRangeString = "C7:C9" 'The range containing the values
    Dim CreateOnSheetName As String: CreateOnSheetName = "Test"  'The sheet containing the dropdown
    Dim CreateInRangeString As String: CreateInRangeString = "A1" 'The range containing the dropdown

    Dim ValueSheet As Worksheet
    Set ValueSheet = Worksheets(ValueSheetName)
    Dim ValueRange As Range: Set ValueRange = ValueSheet.Range(ValueRangeString)
    Dim CreateOnSheet As Worksheet
    Set CreateOnSheet = Worksheets(CreateOnSheetName)
    Dim CreateInRange As Range: Set CreateInRange = CreateOnSheet.Range(CreateInRangeString)
    Dim FieldName As String: FieldName = "Testing Dropdown"
    Dim InputTitle As String:  InputTitle = "Please Select a value"
    Dim InputMessage As String:  InputMessage = "for " & FieldName
    Dim ErrorTitle As String:  ErrorTitle = "Please Select a value"
    Dim ErrorMessage As String:  ErrorMessage = "for " & FieldName
    Dim ShowInput As Boolean:  ShowInput = True
    Dim ShowError As Boolean:  ShowError = True
    Dim ValidationType As XlDVType:  ValidationType = xlValidateList
    Dim ValidationAlertStyle As XlDVAlertStyle:  ValidationAlertStyle = xlValidAlertStop
    Dim ValidationOperator As XlFormatConditionOperator:  ValidationOperator = xlEqual
    Dim ValidationFormula1 As Variant:  ValidationFormula1 = "=" & ValueSheetName & "!" & ValueRange.Address
    Dim ValidationFormula2 As Variant:  ValidationFormula2 = ""

    Call CreateDropDownWithValidationInCell(CreateInRange, InputTitle, InputMessage, ErrorTitle, ErrorMessage, ShowInput, ShowError, ValidationType, ValidationAlertStyle, ValidationOperator, ValidationFormula1, ValidationFormula2)

End Sub

Под выпадающим списком понимается содержание в одной ячейке нескольких значений. Когда пользователь щелкает по стрелочке справа, появляется определенный перечень. Можно выбрать конкретное.

Очень удобный инструмент Excel для проверки введенных данных. Повысить комфорт работы с данными позволяют возможности выпадающих списков: подстановка данных, отображение данных другого листа или файла, наличие функции поиска и зависимости.

Создание раскрывающегося списка

Путь: меню «Данные» — инструмент «Проверка данных» — вкладка «Параметры». Тип данных – «Список».

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

1. Вручную через «точку-с-запятой» в поле «Источник».



2. Ввести значения заранее. А в качестве источника указать диапазон ячеек со списком.



3. Назначить имя для диапазона значений и в поле источник вписать это имя.

Любой из вариантов даст такой результат.



Выпадающий список в Excel с подстановкой данных

Необходимо сделать раскрывающийся список со значениями из динамического диапазона. Если вносятся изменения в имеющийся диапазон (добавляются или удаляются данные), они автоматически отражаются в раскрывающемся списке.

1. Выделяем диапазон для выпадающего списка. В главном меню находим инструмент «Форматировать как таблицу».



2. Откроются стили. Выбираем любой. Для решения нашей задачи дизайн не имеет значения. Наличие заголовка (шапки) важно. В нашем примере это ячейка А1 со словом «Деревья». То есть нужно выбрать стиль таблицы со строкой заголовка. Получаем следующий вид диапазона:



3. Ставим курсор в ячейку, где будет находиться выпадающий список. Открываем параметры инструмента «Проверка данных» (выше описан путь). В поле «Источник» прописываем такую функцию:

Протестируем. Вот наша таблица со списком на одном листе:

Добавим в таблицу новое значение «елка».

Теперь удалим значение «береза».

Осуществить задуманное нам помогла «умная таблица», которая легка «расширяется», меняется.

Теперь сделаем так, чтобы можно было вводить новые значения прямо в ячейку с этим списком. И данные автоматически добавлялись в диапазон.

1. Сформируем именованный диапазон. Путь: «Формулы» — «Диспетчер имен» — «Создать». Вводим уникальное название диапазона – ОК.



2. Создаем раскрывающийся список в любой ячейке. Как это сделать, уже известно. Источник – имя диапазона: =деревья.
3. Снимаем галочки на вкладках «Сообщение для ввода», «Сообщение об ошибке». Если этого не сделать, Excel не позволит нам вводить новые значения.



4. Вызываем редактор Visual Basic. Для этого щелкаем правой кнопкой мыши по названию листа и переходим по вкладке «Исходный текст». Либо одновременно нажимаем клавиши Alt + F11. Копируем код (только вставьте свои параметры).

Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim lReply As Long
 
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Address = "$C$2" Then
     If IsEmpty(Target) Then Exit Sub
       If WorksheetFunction.CountIf(Range("Деревья"), Target) = 0 Then
          lReply = MsgBox("Добавить введенное имя " & _
                         Target & " в выпадающий список?", vbYesNo + vbQuestion)
          If lReply = vbYes Then
              Range("Деревья").Cells(Range("Деревья").Rows.Count + 1, 1) = Target
          End If
       End If
     End If
End Sub
 

5. Сохраняем, установив тип файла «с поддержкой макросов».



6. Переходим на лист со списком. Вкладка «Разработчик» — «Код» — «Макросы». Сочетание клавиш для быстрого вызова – Alt + F8. Выбираем нужное имя. Нажимаем «Выполнить».

Когда мы введем в пустую ячейку выпадающего списка новое наименование, появится сообщение: «Добавить введенное имя баобаб в выпадающий список?».

Нажмем «Да» и добавиться еще одна строка со значением «баобаб».

Выпадающий список в Excel с данными с другого листа/файла

Когда значения для выпадающего списка расположены на другом листе или в другой книге, стандартный способ не работает. Решить задачу можно с помощью функции ДВССЫЛ: она сформирует правильную ссылку на внешний источник информации.

1. Делаем активной ячейку, куда хотим поместить раскрывающийся список.
2. Открываем параметры проверки данных. В поле «Источник» вводим формулу: =ДВССЫЛ(“[Список1.xlsx]Лист1!$A$1:$A$9”).

Имя файла, из которого берется информация для списка, заключено в квадратные скобки. Этот файл должен быть открыт. Если книга с нужными значениями находится в другой папке, нужно указывать путь полностью.

Как сделать зависимые выпадающие списки

Возьмем три именованных диапазона:

Это обязательное условие. Выше описано, как сделать обычный список именованным диапазоном (с помощью «Диспетчера имен»). Помним, что имя не может содержать пробелов и знаков препинания.

1. Создадим первый выпадающий список, куда войдут названия диапазонов.



2. Когда поставили курсор в поле «Источник», переходим на лист и выделяем попеременно нужные ячейки.



3. Теперь создадим второй раскрывающийся список. В нем должны отражаться те слова, которые соответствуют выбранному в первом списке названию. Если «Деревья», то «граб», «дуб» и т.д. Вводим в поле «Источник» функцию вида =ДВССЫЛ(E3). E3 – ячейка с именем первого диапазона.



Выбор нескольких значений из выпадающего списка Excel

Бывает, когда из раскрывающегося списка необходимо выбрать сразу несколько элементов. Рассмотрим пути реализации задачи.

1. Создаем стандартный список с помощью инструмента «Проверка данных». Добавляем в исходный код листа готовый макрос. Как это делать, описано выше. С его помощью справа от выпадающего списка будут добавляться выбранные значения.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("Е2:Е9")) Is Nothing And Target.Cells.Count = 1 Then
        Application.EnableEvents = False
        If Len(Target.Offset(0, 1)) = 0 Then
            Target.Offset(0, 1) = Target
        Else
            Target.End(xlToRight).Offset(0, 1) = Target
        End If
        Target.ClearContents
        Application.EnableEvents = True
    End If
End Sub
 

2. Чтобы выбранные значения показывались снизу, вставляем другой код обработчика.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("Н2:К2")) Is Nothing And Target.Cells.Count = 1 Then
        Application.EnableEvents = False
        If Len(Target.Offset(1, 0)) = 0 Then
            Target.Offset(1, 0) = Target
        Else
            Target.End(xlDown).Offset(1, 0) = Target
        End If
        Target.ClearContents
        Application.EnableEvents = True
    End If
End Sub
 

3. Чтобы выбираемые значения отображались в одной ячейке, разделенные любым знаком препинания, применим такой модуль.


Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("C2:C5")) Is Nothing And Target.Cells.Count = 1 Then
        Application.EnableEvents = False
        newVal = Target
        Application.Undo
        oldval = Target
        If Len(oldval) <> 0 And oldval <> newVal Then
            Target = Target & "," & newVal
        Else
            Target = newVal
        End If
        If Len(newVal) = 0 Then Target.ClearContents
        Application.EnableEvents = True
    End If
End Sub


Не забываем менять диапазоны на «свои». Списки создаем классическим способом. А всю остальную работу будут делать макросы.

Выпадающий список с поиском

1. На вкладке «Разработчик» находим инструмент «Вставить» – «ActiveX». Здесь нам нужна кнопка «Поле со списком» (ориентируемся на всплывающие подсказки).



2. Щелкаем по значку – становится активным «Режим конструктора». Рисуем курсором (он становится «крестиком») небольшой прямоугольник – место будущего списка.



3. Жмем «Свойства» – открывается перечень настроек.



4. Вписываем диапазон в строку ListFillRange (руками). Ячейку, куда будет выводиться выбранное значение – в строку LinkedCell. Для изменения шрифта и размера – Font.

Скачать пример выпадающего списка

При вводе первых букв с клавиатуры высвечиваются подходящие элементы. И это далеко не все приятные моменты данного инструмента. Здесь можно настраивать визуальное представление информации, указывать в качестве источника сразу два столбца.

programm-school.ru

Создаем расширенный список выбора в Excel с помощью VBA

Автор: Deys

6-8 минут

В статье «Создание списка выбора в Excel 2003» были рассмотрены способы создания списков выбора, но в этих способах есть небольшое неудобство при работе с большими списками, а именно поиск нужного значения. В этой статье будет описан способ создания списков в Excel с помощью средств языка VBA, более универсальный, с реализованной возможностью быстрого поиска.

Задача: Создать форму выбора значений из списка и их вставка в ячейку. Вызов формы осуществляется только на определенных столбцах, при этом на каждый столбец отображается свой набор значений. Форма вызывается правой кнопкой мыши(ПКМ).

Приступим к реализации. Для начала нам необходимо создать списки значений на отдельном листе. Назовем этот лист «Списки».

Начиная с первого столбца, первой строки, создадим списки следующим образом:

где, первая строка — наименование списка.

Лист, в котором необходимо заполнение и выбор значений, назовем реестр и выглядеть будет так:

т.е. нам необходимо с помощью выбора из списка подставлять значения в столбцы : B, C, D, F.

Открываем редактор VB (Alt+F11)
В редакторе зададим нашим листам в окне «Properties» следующие имена:

Листу с реестром зададим имя — reestr.
Лист со списками же, получит имя — spisok.

Далее, создадим форму с именем (name) «SelectList», добавим на нее элементы Listbox и TextBox.

Имена для этих элементов следующие:
Listbox — List
TextBox — SearchText

В итоге получится форма следующего вида:

Теперь необходимо прописать процедуры в код нашей формы. Для этого выделите форму и нажмите F7, после чего вставьте следующий код:

‘глобальные переменные
Public R, C, count As Long
Public SheetOut As String
Public numList As Byte

‘Вставка значения двойным кликом в общем листе
Private Sub List_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If List.Text <> «» Then
   Sheets(SheetOut).Cells(R, C) = List.Text
   SelectList.Hide
End If
End Sub

‘Вставка значения нажатием Enter в листе Результата поиска
Private Sub List_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 13 Then
  If List.Text <> «» Then
      Sheets(SheetOut).Cells(R, C) = List.Text
      SelectList.Hide
  End If
End If

End Sub

Private Sub SearchText_Change() ‘Процедура поиска и отображения результатов
 count = 2
 List.Clear

  While Trim(spisok.Cells(count, numList)) <> «»

    If InStr(1, LCase(spisok.Cells(count, numList)), LCase(SearchText.Text)) > 0 Then
        List.AddItem spisok.Cells(count, numList)
     End If

    count = count + 1

 Wend

End Sub

Public Sub LoadList() ‘Процедура загрузки списка
  count = 2
 List.Clear ‘очищаем список
 SearchText.Text = «»

  While Trim(spisok.Cells(count, numList)) <> «»

    List.AddItem spisok.Cells(count, numList)
    count = count + 1
 Wend
 SelectList.Caption = «Выберите — » & spisok.Cells(1, numList)

      End Sub

Все. Элементы формы запрограммированы. Немного о процедурах по порядку:

• List_DblClick — процедура вызываемая двойным кликом мыши по выбранному в списке значению. При выполнении, происходит вставка значения в ячейку листа «Реестр» координаты которой переданы в глобальных переменных R(строка), C(столбец);
• List_KeyPress — процедура аналогична по действию с процедурой List_DblClick, только вставка осуществляется при нажатии клавиши Enter;
• SearchText_Change — процедура, вызываемая при вводе символов в строку поиска. В результате работы данной процедуры, происходит обновление списка, значения которого содержат введенные символы в поле SearchText. Ввести достаточно часть названия и будут отображены значения(значение) содержащие эту часть названия;
• LoadList — дополнительная процедура, которая загружает список в элемент List. Вызов производится в следующей части кода.

Для того, чтобы произвести вызов формы с нужным нам списком при нажатии правой кнопки мыши по ячейке листа Excel, необходимо в объект reestr (лист с реестром) добавить следующий код:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
‘вызов списка по щелчку ПКМ
  Select Case Target.column
     Case 2: loadform Target, 1, Cancel
     Case 3: loadform Target, 2, Cancel
     Case 4: loadform Target, 3, Cancel
     Case 6: loadform Target, 4, Cancel
    ‘….
  End Select
End Sub

Private Sub loadform(ByVal Target As Range, numList As Byte, Cancel As Boolean)
Cancel = True ‘отключает показ контекста после закрытия формы

 With SelectList ‘ отправляем параметры форме, загружаем список и откр. форму

    .R = Target.Row
    .C = Target.column
    .numList = numList
    .LoadList
    .SearchText.SetFocus
    .SheetOut = reestr.Name
    .Show
 End With

 End Sub

Процедура:

• loadform — загружает форму со списком, передает координаты ячейки, в которой произошел правый клик (глобальные переменные С и R) и вызывает процедуру LoadList для загрузки списка;
• Worksheet_BeforeRightClick — процедура, которая вызывается по событию нажатия ПКМ на листе. Собственно это наша ключевая процедура в которой происходит определение столбца, в котором необходимо использовать форму выбора из списка и задается номер загружаемого списка. Все это происходит в операторе Select Case.

Логика работы!

В Target.column возвращается номер столбца, в котором произошел клик ПКМ. Этот номер ищется в списке Select , если номер найден, то запускается процедура loadform с загрузкой соответствующего списка.

Например, Case 2: loadform Target, 1, Cancel, если кликнули ПКМ по второму столбцу (Case 2), то вызываем процедуру loadform, передаем ей координаты ячейки, которые находятся в Target, затем, указываем номер столбца списка (лист «Списки»), который необходимо загрузить.

Соответственно, для столбца в реестре:
 2 загружаем список 1 (Месяц)
 3 загружаем список 2 (Склад)
 4 загружаем список 3 (НаимТовара)
 6 загружаем список 4 (НаимКА)

На другие столбцы реакции не произойдет, будет вызвано контекстное меню. Этот список можно сократить (достаточно убрать Case 2, 3 ..) или добавить.

Снимок работающего списка

Вот и все. Если возникли вопросы, пишите.
 

П.С.: Данный вариант реализации списков отлично работает в Excel 2003-2007-2010

Прикрепленный файл: lists_vba.zip