Excel宏操作绘制学生成绩曲线图

需求:

原始数据是多张表,
每张表中的内容为同一班级一次考试的各科成绩,
多张表意味着多次考试。
通过宏命令在菜单中建立一个命令按钮,
能够生成一个学生多次考试的单科/平均分等成绩曲线图。

Demo:

没有网络可以查资料,所以搞了好几天晚上

今天终于弄完(还有好多情况没有考虑)

通过生成一个汇总页面方式做的图

(正常应该是引用多sheet页的单元格,不清楚是不是这样)

结果:

基本功能:根据选定单元格所在行,生成成绩曲线图

宏代码,版本Office 2007

Sub 成绩曲线图()
'
' 成绩曲线图 Macro
'
'studentCode存放学号
    Dim studentCode As String
    studentCode = Selection.Value
    'MsgBox (studentCode)
   
    '单元格所在行
    Dim cellRow, cellColumn As Integer
    cellRow = ActiveCell.Row     '活动单元格所在的行数
    cellColumn = ActiveCell.Column '活动单元格所在的列数
    'MsgBox (cellRow)
    'MsgBox (cellColumn)

    '删除存在的个人汇总页
    Dim sheetsCount As Integer
    For sheetsCount = 1 To Sheets.Count
        If Sheets(sheetsCount).Name = "个人成绩汇总" Then
                '取消显示提示框
                Application.DisplayAlerts = False
                Sheets("个人成绩汇总").Select
                ActiveWindow.SelectedSheets.Delete
                '还原显示提示框
                Application.DisplayAlerts = True
                Exit For
            Else
        End If
    Next sheetsCount

    '新建个人成绩汇总页
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "个人成绩汇总"
   
    '构建行头
    Sheets(1).Select
    Rows("1:1").Select
    Selection.Copy
    Sheets("个人成绩汇总").Select
    Rows("1:1").Select
    ActiveSheet.Paste
   
    '复制成绩
    Dim term As Integer
    For term = 1 To Sheets.Count - 1
        Sheets(term).Select
        Rows(cellRow).Select
        Selection.Copy
        Sheets("个人成绩汇总").Select
        Rows(term + 1).Select
        ActiveSheet.Paste
    Next term
   
    '处理列头
    For sheetsCount = 1 To Sheets.Count - 1
        Cells(sheetsCount + 1, "A").Value = Sheets(sheetsCount).Name
    Next sheetsCount
   
    '设置A1单元格为学生名,并删除姓名列
    Range("A1").Value = Range("B2").Value
    Columns(2).Delete
   
    '计算每行各科考试平均分
    Dim rowCount, colCount As Integer
    rowCount = ActiveSheet.Range("A65535").End(xlUp).Row
    colCount = ActiveSheet.Range("IV1").End(xlToLeft).Column
    'MsgBox (rowCount)
    'MsgBox (colCount)
   
    '写平均分四个字
    Cells(1, colCount + 1).Value = "平均分"
    '逐行计算平均分
    Dim i, j As Integer
    Dim sum As Integer
    For i = 2 To rowCount
        For j = 2 To colCount
            sum = sum + Cells(i, j).Value
        Next j
        Cells(i, colCount + 1).Value = sum / (colCount - 1)
        sum = 0
    Next i
   
    '选择区域
    'Range(Cells(1, 1), Cells(rowCount, colCount + 1)).Select
    '制图
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=Range(Cells(1, 1), Cells(rowCount, colCount + 1))
    ActiveChart.ChartType = xlLineMarkers
    ActiveChart.PlotBy = xlColumns
'
End Sub

原文地址:https://www.cnblogs.com/futao/p/1648676.html