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/archive/2010/01/15/1648676.html