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