我需要一个散点图,以根据不同的值调整标记的颜色和形状。我在下面找到了代码,并且可以很好地更改颜色,是否可以调整此代码或使用新代码来更改标记,使其基于不同的列值来具有圆形,三角形,正方形等?
Tnx!
Sub ColorScatterPoints3()
Dim cht As Chart
Dim srs As Series
Dim pt As Point
Dim p As Long
Dim Vals$, lTrim#, rTrim#
Dim valRange As Range, cl As Range
Dim myColor As Long
Set cht = ActiveSheet.ChartObjects(1).Chart
Set srs = cht.SeriesCollection(1)
'## Get the series Y-Values range address:
lTrim = InStrRev(srs.Formula, ",", InStrRev(srs.Formula, ",") - 1, vbBinaryCompare) + 1
rTrim = InStrRev(srs.Formula, ",")
Vals = Mid(srs.Formula, lTrim, rTrim - lTrim)
Set valRange = Range(Vals)
For p = 1 To srs.Points.Count
Set pt = srs.Points(p)
Set cl = valRange(p).Offset(0, 1) '## assume color is in the next column.
With pt.Format.Fill
.Visible = msoTrue
'.Solid 'I commented this out, but you can un-comment and it should still work
'## Assign Long color value based on the cell value
'## Add additional cases as needed.
Select Case LCase(cl)
Case "red"
myColor = RGB(255, 0, 0)
Case "blue"
myColor = RGB(0, 0, 255)
Case "green"
myColor = RGB(0, 255, 0)
Case "yellow"
myColor = RGB(255, 192, 50)
End Select
.ForeColor.RGB = myColor
End With
Next
End Sub
答案 0 :(得分:0)
类似的事情应该起作用。在研究答案时,我实际上学到了一些东西。我不知道如何使用Select Case
。感谢您提出问题!
如果您想添加更多形状选项,请参阅本文: https://docs.microsoft.com/en-us/office/vba/api/excel.series.markerstyle
Sub ColorScatterPoints3()
Dim cht As Chart
Dim srs As Series
Dim pt As Point
Dim p As Long
Dim Vals$, lTrim#, rTrim#
Dim valRange As Range, cl As Range
Dim myColor As Long
Dim myShape As String
Set cht = ActiveSheet.ChartObjects(1).Chart
Set srs = cht.SeriesCollection(1)
'## Get the series Y-Values range address:
lTrim = InStrRev(srs.Formula, ",", InStrRev(srs.Formula, ",") - 1, vbBinaryCompare) + 1
rTrim = InStrRev(srs.Formula, ",")
Vals = Mid(srs.Formula, lTrim, rTrim - lTrim)
Set valRange = Range(Vals)
For p = 1 To srs.Points.Count
Set pt = srs.Points(p)
Set cl = valRange(p).Offset(0, 1) '## assume color is in the next column.
Set shp = valRange(p).Offset(0, 2) '## assume shape is in column next to color.
'Color Change
With pt.Format.Fill
.Visible = msoTrue
'.Solid 'I commented this out, but you can un-comment and it should still work
'## Assign Long color value based on the cell value
'## Add additional cases as needed.
Select Case LCase(cl)
Case "red"
myColor = RGB(255, 0, 0)
Case "blue"
myColor = RGB(0, 0, 255)
Case "green"
myColor = RGB(0, 255, 0)
Case "yellow"
myColor = RGB(255, 192, 50)
End Select
.ForeColor.RGB = myColor
End With
'Shape Change
With pt
'## Assign shape value based on the cell value
'## Add additional cases as needed.
Select Case LCase(shp)
Case "square"
myShape = xlMarkerStyleSquare
Case "triangle"
myShape = xlMarkerStyleTriangle
Case "circle"
myShape = xlMarkerStyleCircle
Case "x"
myShape = xlMarkerStyleX
Case "+"
myShape = xlMarkerStylePlus
End Select
.MarkerStyle = myShape
End With
Next
End Sub