Макрос Excel генерирует отчет на основе необработанных данных

Question

В настоящее время я работаю над макросом для создания отчета о баллах студентов и показа процента в конце каждого студента.

Я думаю, что картина не требует пояснений. У меня есть данные о студентах, показанные слева, и я хочу, чтобы такой отчет был справа. Мне удалось создать макрос для 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 Я не учитель. Я просто хочу создать такой отчет

Answer 1

Вы хотите:

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

Answer 2

Я немного изменил приведенный выше код, так что теперь у меня может быть несколько предметов, но я не знаю, как изменить формулу для этого.

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

Как я могу это сделать? Нужно ли для этого создать еще один цикл?