根据值更改散点图excel中特定点的形状

Question

我需要一个散点图来根据不同的值调整标记的颜色和形状。我找到了下面的代码，并且可以很好地更改颜色，是否可以调整此代码或新代码以根据不同的列值将标记更改为圆形、三角形、正方形等？

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

Answer 1

这样的事情应该可以工作。实际上，我在研究答案时学到了一些东西。我不知道如何使用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