如何使用for循环语句在同一工作表上创建图表?

时间:2018-08-08 22:15:18

标签: excel vba excel-vba loops charts

Name       Progress  
Student1    93    
Student2    80
Student3    51
Student4    91
Student5    65
Student6    45          
student7    33

我还是VBA编程的新手。上面是我的数据集示例,下面是我的代码,它能够在不产生任何错误的情况下在右侧填充C到E列。下面是我的图表代码,当我运行它时会给我一个不好的图表。请建议如何在同一工作表的条形图上的C至E列上绘制这些填充值,其中绿色条显示进度> = 90,琥珀色条显示50 <=进度和进度<90,红色条显示进度<50。

Sub ClassCategories()

    Dim startRow As Long, lastRow As Long, n As Integer
    startRow = 2
    n = 8
    Dim i As Long, Progress As Long
    Dim sClass1 As String
    Dim sClass2 As String
    Dim sClass3 As String

    For i = startRow To n
        Progress = ThisWorkbook.Worksheets("sheet1").Range("B" & i).Value
        ' Check progress and classify accordingly
        If Progress >= 90 Then
            sClass3 = Progress
        Else
            sClass3 = " "
        End If

        If 50 <= Progress And Progress < 90 Then
            sClass2 = Progress
        Else
            sClass2 = " "
        End If

        If Progress < 50 Then
            sClass1 = Progress
        Else
            sClass1 = " "
        End If

        ' Write out the class to column C to E
        Worksheets("sheet1").Range("C" & i).Value = sClass1
        Worksheets("sheet1").Range("D" & i).Value = sClass2
        Worksheets("sheet1").Range("E" & i).Value = sClass3
    Next
End Sub

私人子Createachart()

    Dim oChObj As ChartObject, rngSourceData As Range, ws As Worksheet

    Set ws = Sheets("Sheet1")

    Set rngSourceData = ws.Range("C3:E8")

    Set oChObj = ws.ChartObjects.Add(Left:=ws.Columns("A").Left,     
    Width:=290, Top:=ws.Rows(8).Top, Height:=190)



        With oChObj.Chart

             .ChartType = xlColumnClustered

             .SetSourceData Source:=rngSourceData, PlotBy:=xlColumns

             .Axes(xlCategory).CategoryNames = ws.Range("A2:A8")

             .HasTitle = True
        End With


   End Sub

1 个答案:

答案 0 :(得分:0)

我想这段代码就是您所需要的(假设示例表从A1单元格开始):

Sub CreateChart()

    Dim sh As Shape
    Dim ch As Chart
    Dim ser As Series
    Dim lColor&, i%, x, arr

    '// Remove all charts
    For Each sh In ActiveSheet.Shapes
        If sh.Type = msoChart Then sh.Delete
    Next

    '// Add chart to sheet
    With Range("A10:N30")
        Set ch = .Parent.Shapes.AddChart(xlColumn, .Left, .Top, .Width, .Height).Chart
    End With

    With ch

        '// If user's selection is within chart data range,
        '// then Excel will create chart based on data in this range.
        '// We don't need it, so clear the chart out.
        .ChartArea.ClearContents

        '// Add series
        Set ser = ch.SeriesCollection.NewSeries()
        ser.Values = Range("B2:B8").Value
        ser.XValues = Range("A2:A8").Value

        '// Get values
        arr = ser.Values

        '// Format points based on values
        For i = 1 To UBound(arr)
            x = arr(i)
            Select Case True
                Case x >= 90: lColor = vbGreen
                Case x >= 50 And x < 90: lColor = vbYellow
                Case x < 50: lColor = vbRed
            End Select
            ser.Points(i).Format.Fill.ForeColor.RGB = lColor
        Next
    End With

End Sub

您可以使用代码here下载工作簿。

结果:

IMG1

相关问题