---

Sub CalculateAndSortStudents()
    Dim ws As Worksheet
    Dim wsRank As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim c As Long, r As Long
    Dim plusCount As Long, minusCount As Long
    Dim studentName As String
    
    ' Сбор данных для рейтинга
    Dim students() As String
    Dim scoresPlus() As Long
    Dim scoresMinus() As Long
    Dim studentCount As Long
    
    Set ws = ActiveSheet
    
    ' 1. Определяем границы таблицы
    ' Имена детей в строке 2, даты в столбце A (строка 1 — заголовки)
    lastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    If lastCol < 2 Or lastRow < 3 Then
        MsgBox "Таблица пуста или неверно заполнена!", vbExclamation, "Ошибка"
        Exit Sub
    End If
    
    studentCount = lastCol - 1
    ReDim students(1 To studentCount)
    ReDim scoresPlus(1 To studentCount)
    ReDim scoresMinus(1 To studentCount)
    
    ' 2. Считаем плюсы и минусы для каждого ребенка
    For c = 2 To lastCol
        studentName = ws.Cells(2, c).Value ' Имя ребенка во 2-й строке
        students(c - 1) = studentName
        
        plusCount = 0
        minusCount = 0
        
        ' Идем по строкам с датами (с 3-й строки до последней даты)
        For r = 3 To lastRow
            If ws.Cells(r, c).Value = "+" Then
                plusCount = plusCount + 1
            ElseIf ws.Cells(r, c).Value = "-" Then
                minusCount = minusCount + 1
            End If
        Next r
        
        scoresPlus(c - 1) = plusCount
        scoresMinus(c - 1) = minusCount
        
        ' Записываем итоги на следующей строке после дат
        ws.Cells(lastRow + 1, c).Value = plusCount & " (+)"
        ws.Cells(lastRow + 2, c).Value = minusCount & " (-)"
    Next c
    
    ' Подписи для итогов в столбце A
    ws.Cells(lastRow + 1, 1).Value = "Всего плюсов"
    ws.Cells(lastRow + 2, 1).Value = "Всего минусов"
    
    ' 3. Сортировка учеников (метод пузырька) для рейтинга
    Dim i As Long, j As Long
    Dim tempName As String, tempPlus As Long, tempMinus As Long
    
    For i = 1 To studentCount - 1
        For j = i + 1 To studentCount
            ' Критерий: больше плюсов. Если плюсов поровну — меньше минусов.
            If (scoresPlus(i) < scoresPlus(j)) Or _
               (scoresPlus(i) = scoresPlus(j) And scoresMinus(i) > scoresMinus(j)) Then
                
                ' Меняем местами имена
                tempName = students(i)
                students(i) = students(j)
                students(j) = tempName
                
                ' Меняем местами плюсы
                tempPlus = scoresPlus(i)
                scoresPlus(i) = scoresPlus(j)
                scoresPlus(j) = tempPlus
                
                ' Меняем местами минусы
                tempMinus = scoresMinus(i)
                scoresMinus(i) = scoresMinus(j)
                scoresMinus(j) = tempMinus
            End If
        Next j
    Next i
    
    ' 4. Вывод рейтинга на отдельный лист
    On Error Resume Next
    Set wsRank = Sheets("Рейтинг класса")
    On Error GoTo 0
    
    If wsRank Is Nothing Then
        Set wsRank = Sheets.Add(After:=Sheets(Sheets.Count))
        wsRank.Name = "Рейтинг класса"
    Else
        wsRank.Cells.Clear
    End If
    
    ' Заголовки на листе рейтинга
    wsRank.Cells(1, 1).Value = "Место"
    wsRank.Cells(1, 2).Value = "Имя ученика"
    wsRank.Cells(1, 3).Value = "Плюсы"
    wsRank.Cells(1, 4).Value = "Минусы"
    
    ' Заполняем таблицу лидерами
    For i = 1 To studentCount
        wsRank.Cells(i + 1, 1).Value = i
        wsRank.Cells(i + 1, 2).Value = students(i)
        wsRank.Cells(i + 1, 3).Value = scoresPlus(i)
        wsRank.Cells(i + 1, 4).Value = scoresMinus(i)
    Next i
    
    wsRank.Columns("A:D").AutoFit
    ws.Activate
    
    MsgBox "Подсчет завершен! Создан лист 'Рейтинг класса'.", vbInformation, "Успех"
End Sub