☰

Excel 宏根据原始数据生成报告

tag-icon • tag-icon microsoft-excel worksheet-function vba macros
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

你想要：

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

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

我该怎么做？我需要为此创建另一个循环吗？

相关内容