A macro abaixo gera a saída em uma forma que é representada na imagem anexada.
'assumptions
'(1) the input data is in columns A,B,C
'(2) the output data is rendered in columns E,F,G
Sub ListByTeacher()
Dim noOfRows As Integer
Dim i As Integer
Dim j As Integer
Dim c_lv_array(1) As String ' c - course, lv - load value
Dim c As New Collection 'output table with values
Dim k As New Collection 'keys
Dim tmpVar As Variant
'[INPUT]
'identify no of rows with data
i = 1
Do While Len(Cells(i, 1).Value) > 0
i = i + 1
Loop
noOfRows = i - 1
'Loop through input data rows and build the collection of teachers
For i = 2 To noOfRows
c_lv_array(0) = Trim(CStr(Cells(i, 1).Value))
c_lv_array(1) = Trim(CStr(Cells(i, 2).Value))
On Error Resume Next
tmpVar = c.Item(Trim(CStr(Cells(i, 3).Value))) 'if teacher in collection
If IsArray(tmpVar) = True Then 'exists
If InStr(1, tmpVar(0), c_lv_array(0), vbBinaryCompare) = 0 Then
'c_lv_array(0) = c_lv_array(0) & ", " & tmpVar(0) 'use this line or below one
c_lv_array(0) = tmpVar(0) & ", " & c_lv_array(0) 'reversed order to the above line
c_lv_array(1) = CStr(CInt(c_lv_array(1)) + CInt(tmpVar(1)))
End If
c.Remove Trim(CStr(Cells(i, 3).Value))
c.Add Item:=c_lv_array, Key:=Trim(CStr(Cells(i, 3).Value))
End If
tmpVar = Empty
c.Add Item:=c_lv_array, Key:=Trim(CStr(Cells(i, 3).Value))
k.Add Item:=Trim(CStr(Cells(i, 3).Value)), Key:=Trim(CStr(Cells(i, 3).Value))
Next i
'[OUTPUT]
'Render the result in s/s
Cells(1, 5) = "Teacher"
Cells(1, 6) = "Courses"
Cells(1, 7) = "Load"
j = 2
For i = 1 To c.Count
tmpVar = c.Item(k.Item(i))
Cells(j, 5) = k.Item(i)
Cells(j, 6) = tmpVar(0)
Cells(j, 7) = tmpVar(1)
j = j + 1
Next i
End Sub