Excelマクロは生データに基づいてレポートを生成します

私は現在、学生のスコアのレポートを作成し、各学生の終わりにパーセンテージを表示するためのマクロに取り組んでいます。

写真は一目瞭然だと思います。左側に示すような学生のデータがあり、右側にそのようなレポートが必要です。私は1人の生徒用にマクロを作成し、各生徒ごとに毎回再実行することができましたが、すべての生徒に対して一度にレポートを作成し、すべての生徒が終了したら停止する方法がわかりません。

次のコードは、新しい学生名が発生するたびに新しい行を作成するためのものです。

Dim iRow As Integer, iCol As Integer
Dim oRng As Range

Set oRng = Range("A4")

iRow = oRng.Row
iCol = oRng.Column

Do
'
If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
    Cells(iRow + 1, iCol).EntireRow.Insert Shift:=xlDown
    iRow = iRow + 2


Else
    iRow = iRow + 1
End If
'
Loop While Not Cells(iRow, iCol).Text = ""

しかし、パーセンテージ計算のためにコードを入力する場所がわかりません。

ActiveCell.FormulaR1C1 = "=(R[-3]C+R[-2]C+R[-1]C)/COUNT(R[-3]C:R[-1]C)"

計算は非常に簡単ですが、ループの方法はわかりません。セルをマージして、セル用のボックスを作成できます。私はそれを正しくやっているかどうかわかりません。しかし、これを実現する簡単な方法があれば、教えてください。私は長い道のりを進んでいると思うが、私はこれの初心者です。そして、人の名前がマージされるように、マージコードをどこに入力する必要があります。

不明な点がある場合はお知らせください。

前もって感謝します。

PS私は教師ではありません。このようなレポートを作成したいだけです

あなたはしたい：

1. 各学生名の下に行を挿入します
2. 学生の名前のセルを結合します（文字が表すものと想定しています）
3. 生徒の太い境界線を含む境界線を追加します
4. 各生徒の平均を計算する

解決策は次のとおりです。

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 = ""

上記のコードを少し変更して、複数のサブジェクトを作成できるようにしましたが、式を変更する方法がわかりません。

Dim iRow As Integer, iCol As Integer, nRow As Integer, mRow 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
nRow = Application.WorksheetFunction.CountIf(Range("A1:A12"), "a")
mRow = nRow - 1

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 - mRow, 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 - mRow, 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 = "=SUM(R[-5]C:R[-1]C)/COUNT(R[-5]C:R[-1]C)"
        Cells(iRow + 1, iCol + 2).Font.Bold = True
        iRow = iRow + mRow


    Else
        iRow = iRow + 1
    End If

Loop While Not Cells(iRow, iCol).Text = ""

これまでは、大丈夫です。ただし、5以外の場合は、被験者の平均を取得できません。整数値を変更しようとしましたが、機能しないようです。

Cells(iRow + 1, iCol + 2) _
                .FormulaR1C1 = "=SUM(R[-nRow]C:R[-1]C)/COUNT(R[-nRow]C:R[-1]C)"

どうやってやるの？このために別のループを作成する必要がありますか？