Макрос выпадающего списка с несколькими значениями в Excel

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

Как сделать связанный выпадающий список в «Эксель», зависящий от значения в соседней ячейке.

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

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

Для этого необходимо:

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

После этой процедуры следует записать макрос в документ.

Для записи макроса следует:

  • Открыть вкладку «Разработчик» ( Если вкладка отключена, включите ее в разделе Файл=> Параметры=> Настройка Ленты);

Разработчик

 

  • Во вкладке «Разработчик» выбрать кнопку «Просмотр кода»;
  • В открывшееся окно записать макрос;

Макрос

  • Закрыть окно с макросом.

Давайте рассмотрим несколько макросов с выпадающими списками.

Первый макрос со смещением списка в сторону (горизонтально).

Горизонтальный список
Текст макроса:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range(«B2:B10»)) 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
Необходимо обратить внимание, что в строке :
If Not Intersect(Target, Range(«B1:B10»)) Is Nothing And Target.Cells.Count = 1 Then
Значения («B1:B10»)— это диапазон в пределах которого будет работать выпадающий список.
Аналогичным образом можно создать выпадающий список со смещением вниз и выпадающий список, записывающий в ячейку несколько значений через знак табуляции или пробел.

Макрос выпадающего списка со смещением вниз:

Вертикальный список
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

Макрос выпадающего списка с внесением нескольких значений в одну ячейку:

Накопительный список
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range(«B2:B5»)) 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

В строке If Not Intersect(Target, Range(«B2:B5»)) Is Nothing And Target.Cells.Count = 1 Then
указывается диапазон действия макроса.
В строке
Target = Target & «//» & newVal
указывается разделитель «//». Его можно заменить на любой знак препинания, текст или поставить пробел.

 

Добавить комментарий

Ваш e-mail не будет опубликован. Обязательные поля помечены *