Выпадающий список с добавлением новых элементов
Предположим, что у нас есть справочник с именами сотрудников и таблица, куда этих сотрудников нужно вносить:
Задача состоит из двух частей:
- Сделать выпадающий список, причем так, чтобы при дописывании новых людей к справочнику - они автоматически появлялись и в выпадающем списке.
- Реализовать возможность добавления новых людей в список и с другой стороны - при вводе нового имени в любую из жёлтых ячеек оно должно автоматически добавляться к справочнику (и в выпадающий список в будущем, само-собой).
Такая вот двухсторонняя связь справочника и выпадающего списка.
Шаг 1. Создаем умную таблицу
Сначала превратим справочник в "умную" таблицу, чтобы воспользоваться одним из главных её преимуществ - динамической автоподстройкой размеров при добавлении новых данных.
Для этого выделим весь справочник (ячейки A1:A7) и нажмём сочетание клавиш Ctrl+T или выберем Главная - Форматировать как таблицу (Home - Format as Table). В следующем окне можно смело жать ОК:
Шаг 2. Создаем динамический именованный диапазон
Теперь создадим именованный диапазон, указывающий на заполненные именами ячейки в нашем справочнике. Для этого выделим в справочнике уже только имена без шапки (ячейки A2:A7) и в левой части строки формул (там будет имя таблицы) введём имя для нашего диапазона (например Люди):
После ввода имени обязательно нужно нажать на клавишу Enter - слово Люди исчезнет из этого поля, но диапазон будет создан.
Хитрость тут в том, что поскольку мы выделяли столбец уже в "умной" таблице, то и именованный диапазон у нас получился завязанным на колонку [Справочник], а не на конкретные выделенные ячейки. Убедиться в этом можно, если выбрать на вкладке Формулы команду Диспетчер имен (Formulas - Name Manager) и посмотреть куда ссылается имя Люди:
Шаг 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 будет спрашивать:
... и при утвердительном ответе пользователя автоматически добавлять новое имя к справочнику и в выпадающий список в дальнейшем.
Ссылки по теме
- 4 способа создать выпадающий список в ячейке листа
- Как создать список из которого будут автоматически удаляться использованные элементы
- Автоматическое создание списка при помощи надстройки PLEX
- Связанные выпадающие списки (от того, что выбрано в первом - зависит содержимое второго)
- Выпадающий список для выбора изображений (фотографий товаров, сотрудников и т.д.)
Помогите, пожалуйста, объединить два макроса в один
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lReply As Long
If Target.Cells.Count > 1 Then Exit Sub
If Target.Address = "$D$2" Then
If IsEmpty(Target) Then Exit Sub
If WorksheetFunction.CountIf(Range("People", Target) = 0 Then
lReply = MsgBox("Добавить введенное имя " & _
Target & " в выпадающий список?", vbYesNo + vbQuestion)
If lReply = vbYes Then
Range("People".Cells(Range("People".Rows.Count + 1, 1) = Target
End If
End If
End If
End Sub
И
Private Sub Worksheet_Change(ByVal Target As Range)
For Each cell In Target '
If Not Intersect(cell, Range("A3:A100" Is Nothing Then '
With cell.Offset(0, 1) '
Application.Calculation = xlManual
.Value = Now
Application.Calculation = xlAutomatic
End With
End If
Next cell
For Each cell In Target '
If Not Intersect(cell, Range("F3:F100" Is Nothing And cell Like "Устранено*" Then '
With cell.Offset(0, 1) '
Application.Calculation = xlManual
.Value = Now
Application.Calculation = xlAutomatic
End With
End If
Next cell
End Sub
Помогите написать правильно в макрос формулу ВПР это для того, чтобы при выборе в выпадающем списке "формула" происходило вычисление по заданной формуле.
У меня все таблицы с данными:
- Искомое значение в ВПР находиться на том же листе что и ячейка с выпадающим списком F2, то есть "Заявка" столбец "Серийный номер компонента" в нем первое значение "E2"
- Таблица находиться на другом листе "ActiveComponentDetails" диапазон A:BA
- Номер столбца на том же листе - 37
В данном виде выделяет данную строчку желтым.
Спасибо большое.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target <> [F2] Then Exit Sub
If Target.Value = "формула" Then Target.Formula = "=ЕСЛИОШИБКА(ВПР([@[Серийный номер компонента]];ActiveComponentDetails!A:BA;37;0);"""
End Sub
можно ли сделать на одном листе несколько раскрывающихся списков и под каждый из списков будет свой справочник на том же листе?
что надо в макросе менять (кроме ссылок на диапазоны)?
Мне данная кодировка не помогает. Что там нужно менять? Поможете?
И меня это интересует.
Private Sub Workbook_SheetChange(ByVal Target As Range)
Set p = Range("Источник2")
If Target.Cells.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
If Not Intersect(Target, Range ("c2:c1000,d2:d1000") Is Nothing Then
If WorksheetFunction.CountIf(p, Target) = 0 Then
r = MsgBox("Taze sozi gosjakmy?", vbYesNo)
If r = vbYes Then p.Cells(p.Rows.Count + 1) = Target
End If
End If
End Sub
В моем файле на листе 1 Справочник-Именованный список "Сырье_и_Материалы". На листе 2 калькуляция с добавлением элементов из выпадающего списка, таких листов будет множество. Макрос не срабатывает, ошибка Run time error "1004". Подсвечивает ошибку Set p = Range("Сырье_и_Материалы"). Думаю, что нужно указывать листы, но не знаю, как...помогите, пожалуйста
А можете подсказать, как макрос (добавления в список) сохранить не на листе (конфликтует еще с одним макросом), а в книге или отдельно в модуле?
Спасибо.
Полностью повторила Ваш макрос, но не работает в excel-2019 (при вводе нового имени в ячейке с выпад списком, оно не появляется в справочнике). Никаких ошибок не выдает. Во вкладке безопасности запретов нет. Это проблема в версии?
Set p = Worksheets("Лист1").Range("Люди")
If Target.Cells.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
If Not Intersect(Target, Worksheets("Лист2").Range("C5")) 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