为每个学生的测试数据(按行)创建一个新工作表,并在新工作表

时间:2015-10-08 16:37:53

标签: excel excel-vba vba

我正在尝试跟踪整个学年的学生数据,并希望从我输入测试数据的主表中为每个学生创建一个新表。这是我的主要表格:

Main Sheet
  enter image description here

以下是我希望它在添加的表格中的样子:

new sheet enter image description here

我希望每个工作表名称也是学生姓名。 (我想我现在可以得到这个部分,但我还没想出使用VBA图表是否可行/可行)。我的另一种方法是只设置150个标签并手动链接每个单元格/图表....呃

这是我到目前为止所做的工作,我作为一个基础工作(我刚刚录制了宏并从那里开始

Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SetSourceData Source:=Sheets("Data").Range("D8:U8")
ActiveChart.SeriesCollection(1).Name = "=""Renaissance"""
ActiveChart.SeriesCollection(1).Values = _
    "='Data'!$D$8,'Data'!$G$8,'Data'!$M$8,'Data'!$Q$8"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "=""6 Weeks Grade"""
ActiveChart.SeriesCollection(2).Values = _
    "='Data'!$E$8,'Data'!$H$8,'Data'!$J$8,'Data'!$N$8,'Data'!$R$8,'Data'!$T$8"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(3).Name = "=""6 Weeks Unit Test"""
ActiveChart.SeriesCollection(3).Values = _
    "='Data'!$F$8,'Data'!$I$8,'Data'!$K$8,'Data'!$O$8,'Data'!$S$8"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(4).Name = "=""Benchmarks"""
ActiveChart.SeriesCollection(4).Values = "='Data'!$L$8,'Data'!$P$8"
ActiveChart.ApplyLayout (10)
ActiveChart.ChartTitle.Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Axes(xlValue).AxisTitle.Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Text = _
    "Lexile Score or Percent Grade"
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Axes(xlCategory).AxisTitle.Select
ActiveSheet.ChartObjects("Chart 1").Activate
With ActiveSheet.ChartObjects("Chart 1").Chart
.HasDataTable = True
End With

1 个答案:

答案 0 :(得分:0)

我已根据您的需要进行了编辑。

Sub NewChart23()

Dim ws As Worksheet
Dim i As Integer
Dim lastRow As Long

Set ws = Sheets("Data") 'I believe that the sheet you have the data is on this sheet name.
'find last row of information
lastRow = ws.Range("A" & Rows.count).End(xlUp).Row
'Loop; this starts with row# 8 change the 8 to the first row of student data
For i = 8 To lastRow
    Dim cht As Chart
    Set cht = Charts.Add
    With cht

        'I used the column you had, if they are wrong just change them in the code
        .ChartType = xlLineMarkers
        'this sets the name of the page this assumes that the student name is column A
        'If it is a different column change the number 1 to the column number A=1,B=2...
        .Location Where:=xlLocationAsNewSheet, Name:=ws.Cells(i, 1).value
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Name = "Renaissance"
        .SeriesCollection(1).Values = ws.Range("D" & i & ",G" & i & ",M" & i & ",Q" & i)
        .SeriesCollection(1).XValues = Array(1, 2, 3, 4, 5, 6)
        .SeriesCollection.NewSeries
        .SeriesCollection(2).Name = "6 Weeks Grade"
        .SeriesCollection(2).Values = ws.Range("E" & i & ",H" & i & ",J" & i & ",N" & i & ",R" & i & ",T" & i)
        .SeriesCollection.NewSeries
        .SeriesCollection(3).Name = "6 Weeks Unit Test"
        .SeriesCollection(3).Values = ws.Range("F" & i & ",I" & i & ",K" & i & ",O" & i & ",S" & i)
        .SeriesCollection.NewSeries
        .SeriesCollection(4).Name = "Benchmarks"
        .SeriesCollection(4).Values = ws.Range("L" & i & ",P" & i)
        .HasTitle = True
        'Like the page name this assumes that the student name is column A
        'If it is a different column change the number 1 to the column number A=1,B=2...
        .ChartTitle.Text = ws.Cells(i, 1)
        .Axes(xlCategory, xlPrimary).HasTitle = True
        'Change the axis title to what ever you want.
        'Sets the x axis name
        .Axes(xlCategory, xlPrimary).AxisTitle.Text = "6 Week Unit"
        .Axes(xlValue, xlPrimary).HasTitle = True
        'sets the y axis name
        .Axes(xlValue, xlPrimary).AxisTitle.Text = "Lexile Score or Percent Grade"
        'this sets the min-max on the y axis.  change to your liking
        With .Axes(xlValue)
            .MaximumScale = 100
            .MinimumScale = 0
            .MajorUnit = 10
         End With
        'brings in datatable
        .HasDataTable = True
    End With
Next
End Sub

.HasDataTable = True行将以图表左侧的格式提供图表下方的数据,而无需单独重新创建。

enter image description here