Выпадающий список с мультивыбором

111987 30.06.2013 Скачать пример

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

Давайте рассмотрим несколько типовых вариантов реализации такого списка с мультивыбором.

Вариант 1. Горизонтальный

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

dropdown-multi-select1.gif

Выпадающие списки в ячейках С2:С5 в данном примере создаются стандартным образом, т.е.

  1. выделить ячейки С2:С5
  2. на вкладке или в меню Данные (Data) выбрать команду Проверка данных (Data Validation)
  3. в открывшемся окне выбрать вариант Список (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. Вертикальный

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

dropdown-multi-select2.gif

Делается совершенно аналогично, но немного меняется код макроса обработчика:

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. С накоплением в той же ячейке

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

dropdown-multi-select3.gif

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

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-й строке кода на свой (например, пробел или точку с запятой).

Ссылки по теме



Страницы: 1  2  3  
01.07.2013 12:21:04
Добрый день, Николай! Спасибо за полезный материал:)
Почему-то у меня при нажатии на ссылку "Скачать пример" открывается та же страница в новой вкладке.
01.07.2013 20:24:06
Спасибо, поправил ссылочку.
02.07.2013 13:02:11
Николай, добрый день!
При попытке добавить значение, которого нет в списке, макрос ломается. Хотелось бы, чтобы при попытке добавить новое значение выдавало окно с ошибкой... Как быть в такой ситуации? Что необходимо дописать?
03.07.2013 09:20:02
Поправил код, чтобы в случае некорректного ввода, макрос дорабатывал до конца. Спасибо за наводку.
04.07.2013 15:27:25
Николай, большое вам спасибо за очень полезный ресурс и, в частности, за эту статью. У меня возник маленький вопрос по 3 варианту. Успешно его применил и заметил одну особенность: при выборе нескольких значений из выпадающего списка они успешно выстраиваются в ячейке, далее пытаюсь вручную ввести какое-либо значение в эту ячейку, естественно в этот момент появляется окно предупреждения, при нажатии на "Отмена" которого ячейка заполняется выбранными мною ранее значениями в несколько кратном количестве, т.е., например,  я выбрал значения "один" и "два", попытался ввести вручную в эту же ячейку "сто" (которого нет в списке), нажал на "Отмена" окна предупреждения и в результате получил "один,два,один,два,один,два,один,два". Можно ли как-то подправить это? Спасибо заранее
26.07.2013 09:09:33
Спасибо за наводку, Ильшат - поправил код в третьем способе.
26.07.2013 11:57:58
Спасибо большое, Николай!
28.04.2015 11:41:10
Не помогло.
Макрос работает. Набираем несколько значений, здесь ок. Далее добавляем свой текст в ячейку после набранных значений. уходим из ячейки, все данные прописанные в ячейки удваиваются и т.д.
25.07.2013 23:29:25
Вечер добрый!
Николай, а можно ли сделать, чтобы на одном листе обрабатывалось более одного списка?
Спасибо!
26.07.2013 08:58:18
Да, конечно. Просто пропишите в третьей строке макросов не один диапазон, а несколько через запятую:
Range("C2:C5,D2:D10,F15")
День добрый. Хотел узнать, а как реализовать работу третьего способа из данного примера с возможностью добавления новых элементов, как в примере http://planetaexcel.ru/techniques/1/35/
10.09.2013 12:44:50
Николай, добрый день.
Огромное спасибо за сайт, и за ваш труд.
Вопросик, возможно ли использование третьего примера, при условии что данные которые вводятся в выпадающем списке, находятся на другом листе?
17.09.2013 11:37:02
Да, без проблем. С какого листа был указан диапазон для создания выпадающего списка (Данные - Проверка данных - Список - Источник) - все равно (в пределах одной книги). Макрос привязан только к тому листу, где создан выпадающий список, а не с которого берутся для него данные.
24.09.2013 17:19:56
Добрый день.

Николай не могли бы вы  подсказать или пример, или какой функцией реализовать,
У меня выпадающий список с названием организаций 7шт., и я бы хотел , чтобы при выборе какой либо из списка , строчки с реквизитами выбранной организации  заполнялись автоматически, это реально ?

заранее благодарю, уже даже за выпадающие списки
25.09.2013 14:48:25
Владимир, посмотрите вот этот пример. По-моему как раз про вас :)
26.09.2013 18:01:42
Доброго дня!
Николай, очень обрадовалась когда нашла именно то, что мне было нужно - выбор с накоплением в той же  ячейке :). Спасибо Вам - все работает!!!

Маленький, но важный вопрос - есть ли возможность фильтрации по столбцу в котором данные идут с накоплением по первичным значениям?
Excel воспринимает строки с данными полученными накоплением как новые полные данные, а мне необходимо из множествастрок в столбце выбирать те которые содержат первичное значения.
Из доступных способов фижу только фильт->текстовый фильтр->содержит... Но хотелось бы иметь более простой инструмент, либо сводную таблицу.
29.09.2013 14:29:06
Здравствуйте! Помогите пожалуйста разобраться с вопросом перехода к другой ячейке.
Например: список у меня в ячейке 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. отличный сайт! открыл для себя новую америку)))
14.10.2013 13:39:01
Николай, огромное спасибо за ваш прекрасный и познавательный сайт. У меня вопрос по третьему варианту.
Как сделать так чтобы список работал на нескольких листах одной книги? Опыт в работе с макросами = новичок.
Спасибо!

УРА ПОБЕДИЛ, ПРОСТО ДОБАВИЛ МАКРОС В МОДУЛЬ КАЖДОЙ СТРАНИЦИ КНИГИ!:D
20.11.2013 10:38:35
Доброго времени суток! Спасибо за отличный сайт)) Но вот вопрос - вписала макрос №3, мне нужно, чтобы такой список формировался только в одной ячейке, а он теперь работает в каждой ячейке на листе. Вроде вместо С2:С5 указала нужную мне ячейку, а всё равно. Как сделать так, чтобы в остальных ячейках листа значения не ставились через запятую? И ещё проблема - при попытке прописать формулу, ссылающуюся на ячейку с введёнными из списка значениями, формула просто пропадает при нажатии Enter. То есть как будто и не писала ничего.
14.01.2014 06:52:54
Волнует такой же вопрос... Диагноз тот же самый: при включении макроса пропадают формулы в других ячейках при их корректировке (нашел лишь пока одно решение - изменять формулы в данных ячейках только при отключенных макросах, и после чего ставить обязательную защиту  на эти ячейки), и макрос пытается захватить управление всеми выпадающими списками на данном листе...
И не только... проявились интересные последствия! При корректировке значений от руки в свободных ячейках (т.е. там где нет ни формул, ни списков), если заранее не удалить предыдущее изменяемое значение (полностью не очистить ячейку), новое значение не заменяет его, а дополняется через установленный разделитель.
Как это можно побороть? И как корректно прописать диапазон ячеек, в которых действует макрос, если подобный способ вставки необходим только в четырех рядом находящихся столбцах?
Спасибо.
15.12.2013 14:56:25
Николай, добрый день.
Поправьте: варианты 1 и 2 называются одинаково.
10.01.2014 23:20:58
Здравствуйте, а как бы макрос применить к связанным выпадающим спискам?
11.01.2014 01:57:09
Доброго времени суток
Спасибо за подсказки, очень облегчает жизнь и работу.
Помогите пожалуйста решить проблему с применением третьего варианта. Как сделать так, чтобы пользователь не мог повторно ввести одно и то же значение? Например, появляется соответствующее уведомление или из выпадающего списка будет удаляться уже введенное значение. Спасибо.

PS Может кому пригодится: вместо разделителя можно использовать chr(10), тогда новое значение будет переноситься на новую строку в данной ячейке
06.02.2014 12:07:36
Очень круто спасибо Николай! А возможно сделать так, чтобы в 3 варианте вместо имён вставлялся порядковый номер (1,2,3, и т.д.)?
10.02.2014 08:07:26
Добрый день!
Создала список с мультивыбором, все отлично работает, сохраняю книгу в формате: Лист Microsoft Office Excel с поддержкой макросов (.xlsm), при повторном открывание книги, список выпадает но наработает!!!
Подскажите, в чем может быть причина?
15.02.2014 15:08:18
А что с защитой от макросов? Не включена ли? (вкладка Разработчик - Безопасность макросов).
12.02.2014 11:46:44
Добрый день!
Большое спасибо за третий вариант!
Но мне необходимо занести, допустим, два подряд одинаковых значения
Подскажите, пожалуйста
22.02.2014 09:55:32
Разобрался сам:
убрал в 8 строке
And oldVal <> newVal   
09.03.2014 17:01:58
Здравсвуйте!

Подскажите, пожалуйста, есть ли возможность объединить 3-й вариант с вот этим примером. Заранее благодарю!
10.03.2014 14:25:11
Не перестаю благодарить за сайт и за ответы, но есть проблема с 3-м вариантом. Макрос работает но на листе перестала работать команда копировать свойства и при копировании строк вниз ничего не происходит, а та строка которую копирую удаляется и еще не возможно добавить строку на лист. Поскажите- это из - за макроса? (удаляю макрос все работает)???
ABB
17.03.2014 18:20:18
Здравствуйте Николай.
А Вы какой программой делаете gif?
23.03.2014 18:55:40
Camtasia Studio - лучшая программа для таких вещей
20.03.2014 01:26:18
Здравствуйте Николай.
Огромное спасибо за вариант 3. Долго искал, много чего советовали... а тут так просто. Ещё раз спасибо.
23.03.2014 12:11:53
Подскажите, пожалуйста, как исправить код, чтобы при мультивыборе каждое новое значение добавлялось не через ",", как в примере, а на новую строку внутри данной ячейки.
23.03.2014 19:15:05
Вячеслав, попробуйте заменить в 9-й строке "," на Chr(10)
23.03.2014 23:28:21
Николай, спасибо. Не поможете еще с таким вопросом: как удалить одно из значений из ячейки с мультивыбором? На данный момент при удалении выскакивает сообщение о неверном значении
18.04.2014 12:56:50
Добрый день.
Использовал вариант 3
Подскажите пожалуйста что нужно сделать, чтобы была возможность с клавиатуры дописывать к уже имеющимся вариантам свои.
Сейчас если сделать выбор одного варианта, а потом попробовать что-нибудь дописать свое, дублируется выбранный вариант еще раз.
Спасибо.
07.05.2014 12:38:08
Кардинально менять макрос. Тут основная фишка как раз в невозможности лепить свои варианты :(
22.04.2014 19:11:43
Добрый день.
Использую 2 вариант.
Необходимо ограничить количество заполняющихся ячеек до 6.
Подскажите пожалуйста что для этого необходимо.
07.05.2014 12:35:21
Нужно добавить проверку на заполненность нижних ячеек. Примерно так:
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
07.05.2014 21:45:22
Спасибо огромное!
13.05.2014 19:16:58
Добрый день, можно ли этот пример использовать в 2003 Excel? Все работает (если копи-пастим списки из примера), но создаваемый вручную список С2:С5 (как в начале статьи) с диапазоном А1:А8, цепляется на А1. Можно ли его расположить в одном столбце, а диапазон брать из другого, как в примере?
Страницы: 1  2  3  
Наверх