Você deseja:
- Insira uma linha abaixo do nome de cada aluno
- Mesclar as células do nome do aluno (suponho que seja o que as letras representam)
- Adicione bordas, incluindo bordas mais grossas para o aluno
- Calcule uma média para cada aluno
Aqui está uma solução:
Dim iRow As Integer, iCol As Integer
Dim oRng As Range
Dim nRng As Range
Dim persRng As Range
Dim avgRng As Range
Set oRng = Range("A4")
iRow = oRng.Row
iCol = oRng.Column
Do
If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
' Insert row below student name
Cells(iRow + 1, iCol).EntireRow.Insert Shift:=xlDown
' merge name cells
Set nRng = Range(Cells(iRow + 1, iCol), Cells(iRow - 2, iCol))
With nRng
Application.DisplayAlerts = False
.Merge
Application.DisplayAlerts = True
.VerticalAlignment = xlVAlignCenter
.HorizontalAlignment = xlHAlignCenter
.Font.Bold = True
End With
' Add borders
Set persRng = Range(Cells(iRow + 1, iCol), Cells(iRow - 2, iCol + 2))
With persRng.Borders
.LineStyle = xlContinuous
.Color = vbBlack
.Weight = xlThin
End With
' Thick border around average cells
Set avgRng = Range(Cells(iRow + 1, iCol + 1), Cells(iRow + 1, iCol + 2))
avgRng.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium, Color:=vbBlack
' Add percent sign and calculate average
Cells(iRow + 1, iCol + 1).Value = "%"
Cells(iRow + 1, iCol + 2) _
.FormulaR1C1 = "=(R[-3]C+R[-2]C+R[-1]C)/COUNT(R[-3]C:R[-1]C)"
Cells(iRow + 1, iCol + 2).Font.Bold = True
iRow = iRow + 2
Else
iRow = iRow + 1
End If
Loop While Not Cells(iRow, iCol).Text = ""