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