---

Sub РазбитьПоФИО() Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet Dim dict As Object, dictSmen As Object, fio As Variant, sm As Variant Dim lastRow As Long, i As Long, outRow As Long, startRow As Long Dim smena As String
' === 6 префиксов заявок ===
Dim pref(1 To 6) As String
pref(1) = "ACM": pref(2) = "CIM": pref(3) = "DCM"
pref(4) = "EVM": pref(5) = "RSM": pref(6) = "TR"

Dim cntZap(1 To 6) As Long
Dim errZap(1 To 6) As Long
Dim okZap(1 To 6) As Long
Dim idxPos(1 To 6) As Long

Dim zap As String, p As Long, k As Long
Dim maxZap As Long
Dim pctOk As Double

' === переменные для Листа3 ===
Dim lastRow3 As Long, j As Long
Dim rolStr As String, regStr As String
Dim fioNorm As String, fio3Norm As String

' === счётчики ошибочных/правильных заявок (общие) ===
Dim okCnt As Long, errCnt As Long
Dim hVal As Variant
Dim isErr As Boolean
Dim hdr As String, totSmen As String

Set ws1 = ThisWorkbook.Sheets("Лист1")
Set ws2 = ThisWorkbook.Sheets("Лист2")
Set ws3 = ThisWorkbook.Sheets("Лист3")

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

ws2.Cells.Clear

lastRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
lastRow3 = ws3.Cells(ws3.Rows.Count, 1).End(xlUp).Row

' Уникальные ФИО (столбец G Листа1)
Set dict = CreateObject("Scripting.Dictionary")
For i = 2 To lastRow
    If Trim(CStr(ws1.Cells(i, 7).Value)) <> "" Then
        dict(Trim(CStr(ws1.Cells(i, 7).Value))) = 1
    End If
Next i

outRow = 1
For Each fio In dict.Keys
    
    ' ============================================
    ' Поиск роли и региона на Листе3 (A=ФИО, B=Роль, C=Регион)
    ' ============================================
    rolStr = "—"
    regStr = "—"
    fioNorm = UCase(Trim(CStr(fio)))
    For j = 2 To lastRow3
        fio3Norm = UCase(Trim(CStr(ws3.Cells(j, 1).Value)))
        If fio3Norm = fioNorm Then
            If Trim(CStr(ws3.Cells(j, 2).Value)) <> "" Then
                rolStr = CStr(ws3.Cells(j, 2).Value)
            End If
            If Trim(CStr(ws3.Cells(j, 3).Value)) <> "" Then
                regStr = CStr(ws3.Cells(j, 3).Value)
            End If
            Exit For
        End If
    Next j
    
    ' ============================================
    ' Подсчёт смен, заявок по префиксам, ошибочных (общих и по категориям)
    ' ============================================
    Set dictSmen = CreateObject("Scripting.Dictionary")
    For p = 1 To 6
        cntZap(p) = 0
        errZap(p) = 0
        okZap(p) = 0
    Next p
    okCnt = 0
    errCnt = 0
    
    For i = 2 To lastRow
        If Trim(CStr(ws1.Cells(i, 7).Value)) = fio Then
            ' --- смена ---
            smena = UCase(Trim(ws1.Cells(i, 2).Value))
            If smena = "П" Then smena = "ПО"
            If smena <> "" Then
                If dictSmen.Exists(smena) Then
                    dictSmen(smena) = dictSmen(smena) + 1
                Else
                    dictSmen(smena) = 1
                End If
            End If
            
            ' --- заявка: определяем категорию ---
            zap = UCase(Trim(CStr(ws1.Cells(i, 4).Value)))
            isErr = False
            hVal = ws1.Cells(i, 8).Value
            
            If IsNumeric(hVal) Then
                If CDbl(hVal) > 0 Then isErr = True
            End If
            
            If zap <> "" Then
                For p = 1 To 6
                    If Left(zap, Len(pref(p))) = pref(p) Then
                        cntZap(p) = cntZap(p) + 1
                        If isErr Then
                            errZap(p) = errZap(p) + 1
                        Else
                            okZap(p) = okZap(p) + 1
                        End If
                        Exit For
                    End If
                Next p
            End If
            
            ' --- ошибочная/правильная общая по столбцу H ---
            If IsNumeric(hVal) Then
                If CDbl(hVal) > 0 Then
                    errCnt = errCnt + 1
                Else
                    okCnt = okCnt + 1
                End If
            Else
If Trim(CStr(hVal)) = "" Then
                    okCnt = okCnt + 1
                End If
            End If
        End If
    Next i
    
    ' ============================================
    ' Заголовок блока: ФИО (Регион) + смены + Роль
    ' ============================================
    hdr = fio & "  (" & regStr & ")"
    If dictSmen.Count > 0 Then
        hdr = hdr & "     "
        For Each sm In dictSmen.Keys
            hdr = hdr & sm & " - " & dictSmen(sm) & "     "
        Next sm
    End If
    hdr = hdr & "     | Роль: " & rolStr
    
    With ws2.Cells(outRow, 1)
        .Value = hdr
        .Font.Bold = True
        .Font.Size = 12
        .Interior.Color = RGB(220, 230, 245)
    End With
    outRow = outRow + 1
    
    ' ============================================
    ' Итоговая строка: смены + всего + правильно/ошибка
    ' ============================================
    totSmen = ""
    For Each sm In dictSmen.Keys
        totSmen = totSmen & sm & " - " & dictSmen(sm) & "     "
    Next sm
    With ws2.Cells(outRow, 1)
        .Value = "Итого по " & fio & ":     " & totSmen & _
                 "Всего заявок - " & (cntZap(1) + cntZap(2) + cntZap(3) + cntZap(4) + cntZap(5) + cntZap(6)) & _
                 "     | Выполнено правильно - " & okCnt & _
                 "     | Выполнено с ошибкой - " & errCnt
        .Font.Bold = True
        .Font.Italic = True
        .Interior.Color = RGB(255, 235, 156)
    End With
    outRow = outRow + 1
    
    ' ============================================
    ' Заявки по 6 столбцам-префиксам (В СТОЛБИК)
    ' ============================================
    ' Шапка категорий
    For p = 1 To 6
        ws2.Cells(outRow, p) = pref(p)
    Next p
    ws2.Range(ws2.Cells(outRow, 1), ws2.Cells(outRow, 6)).Font.Bold = True
    ws2.Range(ws2.Cells(outRow, 1), ws2.Cells(outRow, 6)).Interior.Color = RGB(230, 240, 230)
    outRow = outRow + 1
    
    ' Высота блока = максимум заявок в любой категории
    maxZap = 0
    For p = 1 To 6
        If cntZap(p) > maxZap Then maxZap = cntZap(p)
    Next p
    If maxZap = 0 Then maxZap = 1
    
    startRow = outRow
    For p = 1 To 6
        idxPos(p) = 0
    Next p
    
    ' Запись заявок сразу в ячейки
    For i = 2 To lastRow
        If Trim(CStr(ws1.Cells(i, 7).Value)) = fio Then
            zap = UCase(Trim(CStr(ws1.Cells(i, 4).Value)))
            If zap <> "" Then
                For p = 1 To 6
                    If Left(zap, Len(pref(p))) = pref(p) Then
                        idxPos(p) = idxPos(p) + 1
                        ws2.Cells(startRow + idxPos(p) - 1, p) = ws1.Cells(i, 4).Value
                        Exit For
                    End If
                Next p
            End If
        End If
    Next i
    
    outRow = startRow + maxZap
    
    ' 1. Строка с количеством
    For p = 1 To 6
        ws2.Cells(outRow, p) = "Кол-во: " & cntZap(p)
    Next p
    ws2.Range(ws2.Cells(outRow, 1), ws2.Cells(outRow, 6)).Font.Italic = True
    ws2.Range(ws2.Cells(outRow, 1), ws2.Cells(outRow, 6)).Font.Color = RGB(0, 80, 160)
    outRow = outRow + 1
    
    ' 2. Строка с ошибочными
    For p = 1 To 6
        ws2.Cells(outRow, p) = "Ошибочных: " & errZap(p)
    Next p
    ws2.Range(ws2.Cells(outRow, 1), ws2.Cells(outRow, 6)).Font.Italic = True
    ws2.Range(ws2.Cells(outRow, 1), ws2.Cells(outRow, 6)).Font.Color = RGB(180, 0, 0)
    outRow = outRow + 1
    
    ' 3. Строка с процентами
    For p = 1 To 6
        If cntZap(p) > 0 Then
            pctOk = okZap(p) / cntZap(p) * 100
        Else
            pctOk = 0
        End If
        ws2.Cells(outRow, p) = "% правильных: " & Format(pctOk, "0.0") & "%"
    Next p
    ws2.Range(ws2.Cells(outRow, 1), ws2.Cells(outRow, 6)).Font.Italic = True
    ws2.Range(ws2.Cells(outRow, 1), ws2.Cells(outRow, 6)).Font.Color = RGB(0, 120, 0)
    outRow = outRow + 1
    
    outRow = outRow + 2   ' отступ между блоками
Next fio

ws2.Columns("A:F").AutoFit

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.
ScreenUpdating = True

MsgBox "Готово! Обработано сотрудников: " & dict.Count
End Sub