Выпадающий список с добавлением новых элементов

Предположим, что у нас есть справочник с именами сотрудников и таблица, куда этих сотрудников нужно вносить:

Исходные данные

Задача состоит из двух частей:

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

Такая вот двухсторонняя связь справочника и выпадающего списка.

Шаг 1. Создаем умную таблицу

Сначала превратим справочник в "умную" таблицу, чтобы воспользоваться одним из главных её преимуществ - динамической автоподстройкой размеров при добавлении новых данных.

Для этого выделим весь справочник (ячейки A1:A7) и нажмём сочетание клавиш Ctrl+T или выберем Главная - Форматировать как таблицу (Home - Format as Table). В следующем окне можно смело жать ОК:

Создаем умную таблицу

Шаг 2. Создаем динамический именованный диапазон

Теперь создадим именованный диапазон, указывающий на заполненные именами ячейки в нашем справочнике. Для этого выделим в справочнике уже только имена без шапки (ячейки A2:A7) и в левой части строки формул (там будет имя таблицы) введём имя для нашего диапазона (например Люди):

Создаем резиновый именованный диапазон

После ввода имени обязательно нужно нажать на клавишу Enter - слово Люди исчезнет из этого поля, но диапазон будет создан.

Хитрость тут в том, что поскольку мы выделяли столбец уже в "умной" таблице, то и именованный диапазон у нас получился завязанным на колонку [Справочник], а не на конкретные выделенные ячейки. Убедиться в этом можно, если выбрать на вкладке Формулы команду Диспетчер имен (Formulas - Name Manager) и посмотреть куда ссылается имя Люди:

Диспетчер имен

Таким образом, при дописывании новых имен к справочнику будет расширяться наша "умная" Таблица1, а за ней и наш именованный диапазон Люди.

Шаг 3. Создаем выпадающий список в ячейке

Выделяем жёлтые ячейки и жмем на вкладке Данные (Data) кнопку Проверка данных (Data Validation) 

Далее выбираем из выпадающего списка Тип данных (Allow) позицию Список (List) и вводим в строку Источник (Source) ссылку на созданный на шаге 1 именованный диапазон (не забудьте перед именем диапазона поставить знак равенства!):

Создаем выпадающий список

Чтобы Excel позволил нам в будущем ввести в список и новые имена, снимем галочки на вкладках Сообщение для ввода (Input Message) и Сообщение об ошибке (Error Alert) и нажмем ОК. Выпадающий список готов!

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

Пополняем справочник

Шаг 4. Добавляем простой макрос

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

Щёлкаем правой кнопкой мыши по ярлычку нашего листа и выбираем Просмотреть код (View Source). Откроется модуль листа в редакторе Visual Basic, куда надо скопировать такой код:

Private Sub Worksheet_Change(ByVal Target As Range)
    Set p = Range("Люди")
    If Target.Cells.Count > 1 Then Exit Sub
    If IsEmpty(Target) Then Exit Sub
    If Not Intersect(Target, Range("D2:D10")) Is Nothing Then
        If WorksheetFunction.CountIf(p, Target) = 0 Then
            r = MsgBox("Добавить новое имя в справочник?", vbYesNo)
            If r = vbYes Then p.Cells(p.Rows.Count + 1) = Target
        End If
    End If
End Sub

Теперь при попытке ввести новое имя в любую из жёлтых ячеек Excel будет спрашивать:

Вопрос о добавлении

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

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


Страницы: 1  2  3  
30.07.2014 09:55:45
Спасибо автору сайта и всем советчикам! Все получилось и так как нужно!
26.08.2014 05:06:55
Доброго времени. Очень понравились толковые разъяснения, помогли во многом.
Николай, возможно, Вы сможете и мне помочь: есть файл, в котором
таблица находится на одном листе, а ввожу в нее данные с другого листа (этой же книги). Excel 2003

Нужно, чтобы добавлялись несколько разных значений ФИО, возраст и т.п.
По Вашему примеру Все работает, но только если таких данных еще нет. Есть ли возможность чтобы в таблицу вносились и дублируемые данные, которые уже есть в таком столбце, т.е. ниже имеющихся сведений добавлялась следующая запись.  Например возраст может быть у разных людей одинаковым, как и некоторые другие данные, или если человек обратился несколько раз - информация о нем должна быть внесена.

Но, возможно, Вы сможете посоветовать более простой способ ввода информации в таблицу, из ячеек которые находятся на другом листе?
26.10.2014 00:15:09
Помогите пожалуйста в решении следующей проблемы. В моём случае именованный диапазон ссылается на ячейки содержащие формулы. Диапазон 50 ячеек, некоторые со значением, остальные пустые. Проблема в том, когда открываешь выпадающий список, то в нём содержится весь диапазон из 50 ячеек, и со значениями, и пустые. Подскажите, как избавиться от показа пустых ячеек в выпадающем списке?
05.08.2015 19:30:04
Николай добрый вечер!
Помогите!
Выскакивает ошибка на строке
If Not Intersect(Target, Range("C2:C24")) Is Nothing Then

В чем может быть проблема?
02.11.2015 19:35:33
Здравствуйте! Можно ли изменить код, что бы можно было не только добавлять, но и удалять уже введённый значения задавая при этом контрольный вопрос? Спасибо!!!
09.02.2016 10:30:13
День добрый! Помогите пожалуйста сделать в файле выпадающие списки с добавлением новых элементов в ячейках F2,F3, F4, F5, K7, K8, K9, K10, Z23, Z24, I29, K29, M29, O29, . Пробовал сделать с помощью макроса, получается только один сделать, дальше не выходит!!!
11.02.2016 17:20:33
Разобрался наконец-то )))
24.02.2016 17:33:45
Добрый день!
Здесь представлен пример для одной ячейки, а как будет выглядеть макрос для нескольких ячеек со своими разными списками?
01.03.2016 15:42:52
Всем спасибо за активность .......... хоть кто-нибудь ткнул см. выше. Разобрался сам, всем спасибо.
27.07.2018 17:45:17
Добрый день! Подскажите, пожалуйста, как вам удалось создать макрос для нескольких ячеек со своими разными списками?
Добрый день ! подскажите пожалуйста как реализовать несколько выпадающих списков с добавлением новых элементов. допустим на одном листе есть 4-5 выпадающих списков на втором листе есть именованные диапазоны. с одним списком получилось сделать так как здесь было показано. но не получается применить это к другим спискам.

Вот как реализован с одним выпадающим


Private Sub Worksheet_Change(ByVal Target As Range)

Dim lReply As Long

   If Target.Cells.Count > 1 Then Exit Sub
       If Not Intersect(Target, Range("C2")) Is Nothing Then
           If IsEmpty(Target) Then Exit Sub
               If WorksheetFunction.CountIf(Sheets("ДЛЯ УТС ФОРМУЛА").Range("Марки"), Target) = 0 Then
                   lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список?", vbYesNo + vbQuestion)
                       If lReply = vbYes Then
                           Worksheets("ДЛЯ УТС ФОРМУЛА").Range("Марки").Cells(Worksheets("ДЛЯ УТС ФОРМУЛА").Range("Марки").Rows.Count + 1, 1) = Target
                       End If
               End If
       End If
Sheets("ДЛЯ УТС ФОРМУЛА").Range("D2:D1000").Sort Key1:=Sheets("ДЛЯ УТС ФОРМУЛА").Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
   DataOption1:=xlSortNormal
End Sub



Что и как нужно добавить что бы это работало на нескольких выпадающих.
И еще - что нужно добавить что бы при вводе первых букв в выпадающий список происходил поиск данных в выпадающем списке!
10.03.2016 15:25:20
Николай, спасибо за ресурс! Интересные вещи нашел для себя именно тут. У меня следующий вопрос.... Как на одном листе в одной книги объединить два события: выпадающий список с мультивыбором и выпадающий список с добавлением новых элементов? Дело в том, что VBA ругается при обнаружении двух одинаковых событий Private Sub Worksheet_Change(ByVal Target As Range)... как же их объединить....
21.03.2016 09:06:55
Добрый день!
А подскажите, возможна ли доработка этого макроса для того, чтобы он заносил новые данные не постоянно в один список, а в список, имя которго введено в ячейке А1, например?
На листе находятся 10 именованных списков, в ячейке А1 выпадающий список с именами этих списков, в ячейках А2:Е2 собственно, данные, которые нужно занести в список, имя которого выбрано в А1.
Спасибо!
10.04.2016 01:46:53
Всем привет. Подскажите как изменить выше указанный макрос. Задача такая. Оговорюсь сразу что список связанный.
Существует лист со списком, где перечислены все основные компоненты. И так же создан 2 Лист где происходит основная работа. Вводим данные списка, и если у нас нет значение списка, то макрос автоматически первым делом ссылался на предыдущую ячейку, чтобы узнать куда нужно добавить новое значение на первый лист. Пример
Выводим из списка первое значение -"Список1_Имя", далее во второй ячейке вводим значение которое бы хотели добавить в таблицу Листа1 - "Список1_Имя". Если в первой ячейке выбрано  -"Список2_Имя", то макрос бы искал в какую таблицу добавить значение.
14.04.2016 20:44:44
Прошу помощи. А если применительно к Вашему примеру, каждому имени соответствуют какие-то значения находящееся, например, в следующих двух столбцах. Пусть это будет номер телефона и e-mail, к примеру. Можно ли сделать, что бы при добавлении нового имени предлагалось ввести также номер телефона и почту этого человека?
04.07.2016 15:19:38
Здравствуйте! Благодарю за сайт, и хочу задать вопрос. Как сделать выпадающий список, но что бы в соседних ячейках менялось значение, например Артикул, цена, Страна производитель....и т.д. ? То-есть менялось значение нескольких ячеек, данные из прайс-листа... Надо для облегчения расчета Спецификации Заказа.
Пробовал по схеме Выбор фото из выпадающего списка, но не получается почему то....
20.07.2016 07:52:31
Товарищи! Все работает, новые данные добавляет, но только в одну и ту же ячейку... то есть один раз добавляет "МАША", другое имя, напр. "СВЕТА", добавляется сюда же, но взамен "МАША"....:(   Как бы сделать, чтоб добавлял новую ячейку и уже туда добавлял новое имя?
30.01.2022 14:40:59
в макросе надо указать имя которое вы задали в диспетчере имен, он на нее ссылается и добавляет в новую ячейку
22.07.2016 09:52:12
Подскажите, пожалуйста. Можно ли сделать так, что при выборе какого-либо объекта из списка автоматически (ну или как-то ещё) открывался другой заданный лист
30.01.2022 14:39:22
может просто активировать лист
ActiveSheet.Activate
или с именем
Sheets("db").Activate 
13.09.2016 12:21:36
Так же как и многие пытаюсь усовершенствовать код под свою задачу.  с примером разобрался все работает, В моем случае нужно при добавлении нового элемента, сделать ввод данных в соседнюю ячейку посредством InputBox. данные.
Подробнее о задумке, динамический список с маршрутами на первом листе. на втором листе таблица с данными. маршрут и расстояние.
На первом листе из списка выбираем "расстояние", в соседнюю ячейку на первом листе заносятся данные из столбца "расстояние" второго листа. (через функцию "ВПР").  Другими словами обеспечить наполнение таблицы с данными не только названием, а и другими данными.
надеюсь не запутал вас.
01.10.2016 21:26:21
Невыходит с макросом если, выпадающая ячейка и список находится на разных листах. Кто нибудь знает как макрос подправить?
30.01.2022 14:34:27
=ДВССЫЛ("db!Изделие1";)
=> проверка ввод данных
02.11.2016 16:46:58
Помогите, пожалуйста,
не удаётся ни выбрать значения из списка значений, ни добавить новое
ошибка 1004
и выделяет жёлтым строку If WorksheetFunction.CountIf(Range("koeffb"), Target) = 0 Then
28.11.2016 10:00:58
Всем доброго времени суток.
Помогите, пожалуйста. Какие изменения нужно сделать (в макросе или ещё где), чтобы вся конструкция "
Выпадающий список с добавлением новых элементов", при нахождении списка и ячейки ввода на разных страницах, работала.
24.01.2017 16:31:24
Огромное спасибо! Очень полезная вещь!
25.01.2017 18:04:07
Очень классный пример!!!
Подскажите пожалуйста, а как можно реализовать этот пример, без привязки в коде к области справочника
If WorksheetFunction.CountIf(Range("People"), Target) = 0 Then

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

Необходимо искать имя списка, которое храниться в диапазоне  "Searchlist" (два столбца:наименование и имя списка), в ячейке  слева от выпадающего списка. В источнике выпадающего списка пишу такую формулу:
=ВПР(ДВССЫЛ(АДРЕС(СТРОКА();СТОЛБЕЦ()-1);ИСТИНА);SearchList;2;0)
список вызывается, но не осуществляется проверка и добавление нового эелемента.

If WorksheetFunction.CountIf(Worksheets("DBLists";).Range("ВПР(ДВССЫЛ(АДРЕС(СТРОКА();СТОЛБЕЦ()-1);ИСТИНА);SearchList;2;0)";), Target) = 0 Then
                 lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список?", vbYesNo + vbQuestion)
                      If lReply = vbYes Then
                         Worksheets("DBLists").Range("List№1").Cells(Worksheets("DBLists").Range("ВПР(ДВССЫЛ(АДРЕС(СТРОКА();СТОЛБЕЦ()-1);ИСТИНА);SearchList;2;0)").Rows.Count + 1, 1) = Target



Private Sub Worksheet_Change(ByVal Target As Range)

Dim lReply As Long

   If Target.Cells.Count > 1 Then Exit Sub
       If Not Intersect(Target, Range("Table.Report[[Столбец 1]:[Столбец 3]]";)) Is Nothing Then
           If IsEmpty(Target) Then Exit Sub
               If WorksheetFunction.CountIf(Worksheets("DBLists";).Range("ВПР(ДВССЫЛ(АДРЕС(СТРОКА();СТОЛБЕЦ()-1);ИСТИНА);SearchList;2;0)";), Target) = 0 Then
                  lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список?", vbYesNo + vbQuestion)
                       If lReply = vbYes Then
                          Worksheets("DBLists";).Range("List№1";).Cells(Worksheets("DBLists";).Range("ВПР(ДВССЫЛ(АДРЕС(СТРОКА();СТОЛБЕЦ()-1);ИСТИНА);SearchList;2;0)";).Rows.Count + 1, 1) = Target
                       End If
               End If
       End If
End Sub
22.02.2017 22:55:38
Добрый вечер всем, подскажите, как к этому выпадающему списку, добавить поиск по вводимым буквам, к примеру, по первым 2-3 буквам (предлагал из имеющегося списка варианты),а  новые чтобы добавлял с авто сортировкой по алфавиту. спасибо
01.04.2017 20:09:47
Здравствуйте!

Подскажите, каким образом модифицировать макрос, если на листе несколько диапазонов с подключенными разными списками
к примеру на одном листе:
  • в колонке E список "Класс"
  • в колонках G, H, I, J, K, список "Осн"
  • в колонках L, M, N, O, P, список "Втор"
  • в колонках Q, R, S список "Гнез"
а подобных листов несколько
26.09.2017 14:13:48
Добрый день!
У меня следующая задача: В ячейке В2 организован выпадающий список, на основе двух именованных диапазонов "Хлеб" и "Сыр", которые выбираются в зависимости от значения в ячейке Е4 (1 или 2). Необходимо модифицировать имеющийся макрос (см. ниже), который бы позволял добавлять новые элементы в "Хлеб" или "Сыр" в зависимости от значения ячейки  Е4. Данные макрос добавляет элементы только в один диапазон.

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

Заранее благодарен за помощь.
Страницы: 1  2  3  
Наверх