Как сделать автоматическое заполнение ячеек, при выборе значения из раскрывающегося списка c несколькими строками и выбором значений?

Question

[bgsmk1]

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

Comments

[Akina]

Пиши Worksheet_Change, например.

Answer 1

[otdameskapizm]

Так, ну смотрите. Как Вам в комментариях написали, что действительно можно сделать через событие Worksheet_Change .

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

Для начала нужно понять, как хранятся данные. Ну допустим они хранятся вот так на листе 2:



Можно написать вот такую функцию, которая будет забирать данные с этого листа. Даже если данные хранятся по другому, то все равно немаловажно понять, как именно они лежат.

Option Explicit

Public Const MainShtIndex As Integer = 1
Public Const DataShtIndex As Integer = 2

Function GetPersonalInfo(Optional Name As String):
    'Функция получает значения аттрибутов для конкретного пользователя
    Dim DataSht As Worksheet, Row As Integer
    Dim NamesRange As Range, Cell As Range
    Dim PersonalAttrs As New Dictionary, Key As String, Item As Variant
    
    PersonalAttrs.CompareMode = CompareMethod.TextCompare
    Set DataSht = Application.ActiveWorkbook.Worksheets(DataShtIndex)
    With DataSht
       Set NamesRange = .Range(.Cells(2, 1), .Cells(4, 1))
       'Здесь мы находим нужное имя для дальнейшего заполнения
       For Each Cell In NamesRange:
            If Cell.Value = Name Then
                Row = Cell.Row
                Exit For
            End If
       Next Cell

       If Row = 0 Then MsgBox Prompt:="Такого человека нет в списке"
       
       'Здесь мы забираем значения аттрибутов
       For Each Cell In .Range(.Cells(Row, 2), .Cells(Row, 7))
            Key = .Cells(1, Cell.Column)
            Item = VBA.IIf(Cell.Value = 1, 1, "")
            PersonalAttrs.Add Key, Item
       Next Cell
    End With
    'Возвращаем словарь со значениями пользовательских аттрибутов
    Set GetPersonalInfo = PersonalAttrs
End Function

После того, как мы получили данные 0 а их мы здесь получили в виде словаря, где в качестве ключей используются атрибуты, а значения - 0 или 1, в зависимости от наличия атрибута у конкретного пользователя. Теперь нам нужно записать это в структуру подобной той, которую Вы указали в вопросе. Типа такого (допустим, что она хранится у нас на листе 1):



Для записи напишем отдельную процедуру:

Sub FillAttrs():
    'Здесь происходит заполнение ячеек, в соответствии со значениями аттрибутов
    Dim MainSht As Worksheet
    Dim PersonalInfo As New Dictionary
    Dim PersonNameRange As Range, AttrRange As Range
    Dim Cell As Range
    Set MainSht = Application.ActiveWorkbook.Worksheets(MainShtIndex)
   
   With MainSht
        Set PersonNameRange = .Cells(2, 1)
        Set AttrRange = .Range(Cells(5, 2), Cells(10, 2))
        Set PersonalInfo = GetPersonalInfo(PersonNameRange.Value)
        
        For Each Cell In AttrRange:
            .Cells(Cell.Row, 1).Value = PersonalInfo.Item(Cell.Value)
        Next Cell
   End With
End Sub

Далее остается только вызывать эту процедуру при каждом изменении ячейки, ФИО в которой мы будем изменять - что-то подобное:

Sub Worksheet_Change(ByVal Target As Range):
    'Здесь выполняется заполнение ячеек при изменении данных
    If Target.Address = "$A$2" Then Call FillAttrs
End Sub

Вуаля...
Теперь при обновлении ячейки с ФИО, будет происходить изменение структуры с атрибутами на листе 1

P.S Заполнение может быть разное, данные могут быть разными, прошу понимать, что это просто один из вариантов, который (я надеюсь) поможет Вам разобраться