Попытка вытащить данные из одного листа в другой на основе определенных критериев

Question

Я новичок в Vba & Excel в целом. У меня есть две таблицы (лист 1 и лист 2):

Лист 1 содержит такую ​​информацию, как Имя (ФИО) и Оценочный балл (Оценки). Каждое имя имеет оценку, связанную с ним.

Лист 2 имеет ячейки, представляющие диапазон оценок. Я пытаюсь вытащить имена сотрудников, которые соответствуют определенной категории в соответствующие поля.

Примеры - Если у Джона Доу и Джейн Доу есть оценка «Превышает А» на Листе 1. На Листе 2 должно быть указано их имя, указанное в том же столбце под именем поля «Превышает А».

Надеюсь, я объяснил это достаточно хорошо. Я приложил картину диапазонов для лучшего понимания:

Answer 1

Sub Grades()

    Dim rng As Range, rngGrades As Range, cll As Range
    Dim i As Integer, j As Integer, iLastCell As Integer

    ' Assuming Sheet2 is set up in the following format:
    ' Grade | Grade | Grade
    '       |       |
    ' Grade | Grade | Grade
    '       |       |
    ' Grade | Grade | Grade
    '       |       |
    ' Can be adjusted if different
    Set rng = Sheets("Sheet2").Range("A1:C6")

    ' It's not specified how the data is structured on Sheet1
    ' Assuming that names are in column A and grades in column B
    iLastCell = Sheets("Sheet1").Range("A1").SpecialCells(xlCellTypeLastCell).Column

    With Sheets("Sheet1")
        Set rngGrades = .Range(.Cells(2, 2), (.Cells(2, iLastCell)))
    End With

    For i = 1 To 5 Step 2
        For j = 1 To 3
            For Each cll In rngGrades
                If cll.Value2 = rng(i, j) Then
                    rng(i + 1, j).Value2 = rng(i + 1, j).Value2 & vbLf & Sheets("Sheet1").Cells(1, cll.Column)
                End If
            Next
        Next
    Next

End Sub