Выпадающий список с мультивыбором
Классический выпадающий список на листе Excel - отличная штука, но позволяет выбрать только один вариант из представленного набора. Иногда именно это и нужно, но бывают ситуации, когда пользователь должен иметь возможность выбрать несколько элементов из списка.
Давайте рассмотрим несколько типовых вариантов реализации такого списка с мультивыбором.
Вариант 1. Горизонтальный
Пользователь выбирает из выпадающего списка элементы один за другим, и они появляются справа от изменяемой ячейки, автоматически составляясь в список по горизонтали:
Выпадающие списки в ячейках С2:С5 в данном примере создаются стандартным образом, т.е.
- выделить ячейки С2:С5
- на вкладке или в меню Данные (Data) выбрать команду Проверка данных (Data Validation)
- в открывшемся окне выбрать вариант Список (List) и указать в качестве диапазона Источник (Source) ячейки с исходными данными для списка A1:A8
Затем в модуль листа нужно добавить макрос, который и будет делать всю основную работу, т.е. добавлять выбранные значения справа от зеленых ячеек. Для этого щелкните правой кнопкой мыши по ярлычку листа с выпадающими списками и выберите команду Исходный текст (Source code). В открывшееся окно редактора Visual Basic нужно вставить следующий код:
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
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:С5 на свой.
Вариант 2. Вертикальный
То же самое, что и в предыдущем варианте, но новые выбранные значения добавляются не справа, а снизу:
Делается совершенно аналогично, но немного меняется код макроса обработчика:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("C2:F2")) 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
Опять же, при необходимости, замените во второй строке этого кода чувствительный диапазон выпадающих списков С2:F2 на свой.
Вариант 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
При желании, можно заменить символ-разделитель (запятую) в 9-й строке кода на свой (например, пробел или точку с запятой).
Почему-то у меня при нажатии на ссылку "Скачать пример" открывается та же страница в новой вкладке.
При попытке добавить значение, которого нет в списке, макрос ломается. Хотелось бы, чтобы при попытке добавить новое значение выдавало окно с ошибкой... Как быть в такой ситуации? Что необходимо дописать?
Макрос работает. Набираем несколько значений, здесь ок. Далее добавляем свой текст в ячейку после набранных значений. уходим из ячейки, все данные прописанные в ячейки удваиваются и т.д.
Николай, а можно ли сделать, чтобы на одном листе обрабатывалось более одного списка?
Спасибо!
Range("C2:C5,D2:D10,F15")Огромное спасибо за сайт, и за ваш труд.
Вопросик, возможно ли использование третьего примера, при условии что данные которые вводятся в выпадающем списке, находятся на другом листе?
Николай не могли бы вы подсказать или пример, или какой функцией реализовать,
У меня выпадающий список с названием организаций 7шт., и я бы хотел , чтобы при выборе какой либо из списка , строчки с реквизитами выбранной организации заполнялись автоматически, это реально ?
заранее благодарю, уже даже за выпадающие списки
Николай, очень обрадовалась когда нашла именно то, что мне было нужно - выбор с накоплением в той же ячейке
Маленький, но важный вопрос - есть ли возможность фильтрации по столбцу в котором данные идут с накоплением по первичным значениям?
Excel воспринимает строки с данными полученными накоплением как новые полные данные, а мне необходимо из множествастрок в столбце выбирать те которые содержат первичное значения.
Из доступных способов фижу только фильт->текстовый фильтр->содержит... Но хотелось бы иметь более простой инструмент, либо сводную таблицу.
Например: список у меня в ячейке B1, в нем я выбираю нужную позицию, и эта позиция должна отобразиться в ячейке A1 (т.е. со смещением влево). При этом, следующая выбранная позиция из списка, должна отобразиться сразу под A1, то есть в A2.
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("B2")) 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(xlDown).Offset(1, 0) = Target End If Target.ClearContents Application.EnableEvents = True End If End SubПомогите пожалуйста, никак не могу додуматься.
Спасибо!
p.s. отличный сайт! открыл для себя новую америку)))
Как сделать так чтобы список работал на нескольких листах одной книги? Опыт в работе с макросами = новичок.
Спасибо!
УРА ПОБЕДИЛ, ПРОСТО ДОБАВИЛ МАКРОС В МОДУЛЬ КАЖДОЙ СТРАНИЦИ КНИГИ!
И не только... проявились интересные последствия! При корректировке значений от руки в свободных ячейках (т.е. там где нет ни формул, ни списков), если заранее не удалить предыдущее изменяемое значение (полностью не очистить ячейку), новое значение не заменяет его, а дополняется через установленный разделитель.
Как это можно побороть? И как корректно прописать диапазон ячеек, в которых действует макрос, если подобный способ вставки необходим только в четырех рядом находящихся столбцах?
Спасибо.
Поправьте: варианты 1 и 2 называются одинаково.
Спасибо за подсказки, очень облегчает жизнь и работу.
Помогите пожалуйста решить проблему с применением третьего варианта. Как сделать так, чтобы пользователь не мог повторно ввести одно и то же значение? Например, появляется соответствующее уведомление или из выпадающего списка будет удаляться уже введенное значение. Спасибо.
PS Может кому пригодится: вместо разделителя можно использовать chr(10), тогда новое значение будет переноситься на новую строку в данной ячейке
Создала список с мультивыбором, все отлично работает, сохраняю книгу в формате: Лист Microsoft Office Excel с поддержкой макросов (.xlsm), при повторном открывание книги, список выпадает но наработает!!!
Подскажите, в чем может быть причина?
Большое спасибо за третий вариант!
Но мне необходимо занести, допустим, два подряд одинаковых значения
Подскажите, пожалуйста
убрал в 8 строке
Подскажите, пожалуйста, есть ли возможность объединить 3-й вариант с . Заранее благодарю!
А Вы какой программой делаете gif?
Огромное спасибо за вариант 3. Долго искал, много чего советовали... а тут так просто. Ещё раз спасибо.
Использовал вариант 3
Подскажите пожалуйста что нужно сделать, чтобы была возможность с клавиатуры дописывать к уже имеющимся вариантам свои.
Сейчас если сделать выбор одного варианта, а потом попробовать что-нибудь дописать свое, дублируется выбранный вариант еще раз.
Спасибо.
Использую 2 вариант.
Необходимо ограничить количество заполняющихся ячеек до 6.
Подскажите пожалуйста что для этого необходимо.
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("C2:F2")) Is Nothing And Target.Cells.Count = 1 Then If WorksheetFunction.CountA(Target.Offset(1,0).Resize(6,1))=6 Then MsgBox "Можно выбрать максимум 6 значений!" Exit Sub End If 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