Так, ну смотрите. Как Вам в комментариях написали, что действительно можно сделать через событие
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 Заполнение может быть разное, данные могут быть разными, прошу понимать, что это просто один из вариантов, который (я надеюсь) поможет Вам разобраться
