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
答案 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下载工作簿。