Sub select_()
Dim d As Object, arr, title, item As String, key As String, s
Dim i As Long, j, lr As Long

Set d = CreateObject("Scripting.Dictionary")

With Worksheets("Лист1") ' имя Лист1 поменять на имя листа с исходными данными
    title = .Cells(1, 1).CurrentRegion.Rows(1).Value ' массив заголовка
    arr = .Cells(1, 1).CurrentRegion.Value ' основной массив
    
    For i = 2 To UBound(arr, 1)
        key = Format(arr(i, 1), "mm.yyyy") & ":" & arr(i, 2) ' сцепляем 2 первых столбца для словаря
        If d.exists(key) Then ' если месяц и фамилия уже есть в словаре, то
            d(key) = d(key) + arr(i, 3) ' прибавляем значение
        Else ' иначе
              d(key) = arr(i, 3) ' записываем значение из 3 столбца
        End If
    Next i
End With

With Worksheets("tmp") ' имя tmp поменять на имя листа с результатом
    .Cells.Clear ' очищаем ячейки на листе
    .Cells(1, 1).Resize(1, UBound(title, 2)) = title ' выгружаем в первую строку заголовок
    lr = 2 ' последняя заполненная строка
    For Each j In d.keys() '  цикл по ключам словаря
        s = Split(j, ":") ' разбиваем ключ с месяцем и ФИО по разделителю :
        .Cells(lr, 1).Resize(1, UBound(s) + 1) = s ' выгружаем в значение s первые 2 столбца
        .Cells(lr, 3) = d(j) ' выгружаем сумму
        lr = lr + 1 ' прибавляем 1 к последней заполненной строке
    Next j
End With
End Sub