Копирование записи из списка в таблицу в Excel VBA

Question

У меня большой список с именами сотрудников, именами сертификации и датами окончания сертификации.

Я пытаюсь написать сценарий для копирования даты окончания сертификации для каждой записи в таблице, в которой имена сотрудников указаны на одной оси, а имена сертификатов - на другой.

Сценарий должен определить, какая ячейка в таблице является правильной ячейкой для каждой записи на основе имени сертификации и имени персонала, а затем скопировать в эту ячейку дату окончания сертификации.

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

Answer 1

Вам не нужен макрос, чтобы сделать это.Просто используйте сводную таблицу:

Если вам действительно нужен код VBA (не очень элегантный, отправьте его в CodeReview для предложений по улучшению):

Sub PivotData()

    Dim rng As Range, cll As Range
    Dim arr As New Collection, a
    Dim var() As Variant
    Dim l As Long
    Dim lRow As Long, lCol As Long

    l = 1

    Set rng = Range("A2:C7")

    ' Create unique list of names
    var = Range("A2:A7")
    On Error Resume Next
    For Each a In var
        arr.Add a, a

    Next
    For l = 1 To arr.Count
        Cells(l + 1, 5) = arr(l)
    Next
    Set arr = Nothing

    ' Create unique list of certificates
    var = Range("B2:B7")
    For Each a In var
        arr.Add a, a
    Next
    For l = 1 To arr.Count
        Cells(1, 5 + l) = arr(l)
    Next
    Set arr = Nothing
    On Error GoTo 0

    Range("F2").FormulaArray = _
        "=IFERROR(INDEX(R2C3:R7C3,MATCH(1,((R2C1:R7C1=RC5)*(R2C2:R7C2=R1C)),0)),"""")"

    With Range("F2")
        lRow = .CurrentRegion.Rows.Count
        lCol = .CurrentRegion.Columns.Count + 4
    End With

    Range("F2:F" & lRow).FillDown
    Range(Cells(2, 6), Cells(lRow, lCol)).FillRight

End Sub