如何根据列值在xy散点图中为点着色？

时间：2013-06-19 14:35:28

标签： excel vba excel-vba charts excel-formula

考虑以下工作表：

     A       B        C        D
1 COMPANY  XVALUE   YVALUE   GROUP
2 Apple     45       35       red
3 Xerox     45       38       red
4 KMart     63       50       orange
5 Exxon     53       59       green

我在Excel中使用了散点图功能来创建以下图表：

enter image description here

但是，图表中的每个点都有一个附加属性：GROUP。共有四个组：red，orange，black和green。我想相应地为每个点着色，这样我就可以看到一个模式（例如，组green几乎总是在图表的左侧）。因为我的列表是500行长，我不能手动执行此操作。我该如何自动完成？

6 个答案:

答案 0 :(得分：70)

非VBA解决方案：

您需要为每个颜色组创建一组额外的数据，以表示该特定组的Y值。您可以使用这些组在图表中创建多个数据集。

以下是使用您的数据的示例：

     A       B        C        D                    E                        F                            G
----------------------------------------------------------------------------------------------------------------------
1| COMPANY  XVALUE   YVALUE   GROUP                 Red                     Orange                       Green
2| Apple     45       35       red         =IF($D2="red",$C2,NA()) =IF($D2="orange",$C2,NA()) =IF($D2="green",$C2,NA())
3| Xerox     45       38       red         =IF($D3="red",$C3,NA()) =IF($D3="orange",$C3,NA()) =IF($D3="green",$C3,NA())
4| KMart     63       50       orange      =IF($D4="red",$C4,NA()) =IF($D4="orange",$C4,NA()) =IF($D4="green",$C4,NA())
5| Exxon     53       59       green       =IF($D5="red",$C5,NA()) =IF($D5="orange",$C5,NA()) =IF($D5="green",$C5,NA())

之后看起来应该是这样的：

     A       B        C        D          E           F          G
---------------------------------------------------------------------
1| COMPANY  XVALUE   YVALUE   GROUP       Red         Orange     Green
2| Apple     45       35       red         35         #N/A       #N/A    
3| Xerox     45       38       red         38         #N/A       #N/A
4| KMart     63       50       orange     #N/A         50        #N/A
5| Exxon     53       59       green      #N/a        #N/A        59

现在，您可以使用不同的数据集生成图表。这是一张显示此示例数据的图片：

enter image description here

您可以将系列(X;Y)值分别更改为B:B ; E:E，B:B ; F:F，B:B ; G:G，以便在添加更多数据时自动更新图表。< / p>

答案 1 :(得分：15)

我回答了一个非常相似的问题：

https://stackoverflow.com/a/15982217/1467082

您只需迭代系列“.Points集合，然后根据您需要的条件分配点数.Format.Fill.ForeColor.RGB。

<强>已更新

下面的代码将根据屏幕截图为图表着色。这仅假设使用三种颜色。您可以为其他颜色值添加其他case语句，并将myColor的赋值更新为每个颜色值的相应RGB值。

screenshot 

Option Explicit
Sub ColorScatterPoints()
    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 "orange"
                    myColor = RGB(255, 192, 0)
                Case "green"
                    myColor = RGB(0, 255, 0)
            End Select

            .ForeColor.RGB = myColor

        End With
    Next


End Sub

答案 2 :(得分：2)

如果您对x轴文本类别进行编码，请在单列中列出它们，然后在相邻列中根据相关的文本类别代码列出各个变量的绘图点，而对不相关的文本类别代码仅保留空白单元格，则可以分散绘制并获得显示的结果。有任何问题让我知道。 enter image description here

答案 3 :(得分：1)

我看到有一个VBA解决方案和一个非VBA解决方案，两者都非常好。我想提出我的 Javascript解决方案。

有一个名为Funfun的Excel加载项，允许您在Excel中使用javascript，HTML和css。它有一个在线编辑器，带有嵌入式电子表格，您可以在其中构建图表。

我已经使用Chart.js为您编写了此代码：

https://www.funfun.io/1/#/edit/5a61ed15404f66229bda3f44

要创建此图表，我在电子表格中输入了数据并使用json文件读取，它是short文件。

我确保在script.js中以正确的格式添加，因此我可以将其添加到我的图表中：

var data = [];
var color = [];
var label = [];

for (var i = 1; i < $internal.data.length; i++)
{
    label.push($internal.data[i][0]);
    data.push([$internal.data[i][1], $internal.data[i][2]]);
    color.push($internal.data[i][3]);
}

然后我创建散点图，每个点都有指定的颜色和位置：

 var dataset = [];
  for (var i = 0; i < data.length; i++) {   
    dataset.push({
      data: [{
        x: data[i][0],
        y: data[i][1] 
      }],
      pointBackgroundColor: color[i],
      pointStyle: "cercle",
      radius: 6  
    });
  }

创建散点图后，我可以通过粘贴funfun Excel add-in中的网址将其上传到Excel中。以下是我的示例：

final

完成此操作后，您可以通过更改电子表格中的值，立即在Excel中更改点的颜色或位置。

如果您想在图表中添加额外的点，您只需修改data json文件中short的半径。

希望 Javascript解决方案有所帮助！

披露：我是funfun的开发者

答案 4 :(得分：0)

试试这个：

Dim xrndom As Random
    Dim x As Integer
    xrndom = New Random

    Dim yrndom As Random
    Dim y As Integer
    yrndom = New Random
    'chart creation
    Chart1.Series.Add("a")
    Chart1.Series("a").ChartType = DataVisualization.Charting.SeriesChartType.Point
    Chart1.Series("a").MarkerSize = 10
    Chart1.Series.Add("b")
    Chart1.Series("b").ChartType = DataVisualization.Charting.SeriesChartType.Point
    Chart1.Series("b").MarkerSize = 10
    Chart1.Series.Add("c")
    Chart1.Series("c").ChartType = DataVisualization.Charting.SeriesChartType.Point
    Chart1.Series("c").MarkerSize = 10
    Chart1.Series.Add("d")
    Chart1.Series("d").ChartType = DataVisualization.Charting.SeriesChartType.Point
    Chart1.Series("d").MarkerSize = 10
    'color
    Chart1.Series("a").Color = Color.Red
    Chart1.Series("b").Color = Color.Orange
    Chart1.Series("c").Color = Color.Black
    Chart1.Series("d").Color = Color.Green
    Chart1.Series("Chart 1").Color = Color.Blue

    For j = 0 To 70
        x = xrndom.Next(0, 70)
        y = xrndom.Next(0, 70)
        'Conditions
        If j < 10 Then
            Chart1.Series("a").Points.AddXY(x, y)
        ElseIf j < 30 Then
            Chart1.Series("b").Points.AddXY(x, y)
        ElseIf j < 50 Then
            Chart1.Series("c").Points.AddXY(x, y)
        ElseIf 50 < j Then
            Chart1.Series("d").Points.AddXY(x, y)
        Else
            Chart1.Series("Chart 1").Points.AddXY(x, y)
        End If
    Next

答案 5 :(得分：0)

最近我不得不做类似的事情，我用下面的代码解决了它。希望它有所帮助！

Sub ColorCode()
Dim i As Integer
Dim j As Integer
i = 2
j = 1

Do While ActiveSheet.Cells(i, 1) <> ""


If Cells(i, 5).Value = "RED" Then
ActiveSheet.ChartObjects("YourChartName").Chart.FullSeriesCollection(1).Points(j).MarkerForegroundColor = RGB(255, 0, 0)



Else

If Cells(i, 5).Value = "GREEN" Then
ActiveSheet.ChartObjects("YourChartName").Chart.FullSeriesCollection(1).Points(j).MarkerForegroundColor = RGB(0, 255, 0)

Else

If Cells(i, 5).Value = "GREY" Then
ActiveSheet.ChartObjects("YourChartName").Chart.FullSeriesCollection(1).Points(j).MarkerForegroundColor = RGB(192, 192, 192)

Else

If Cells(i, 5).Value = "YELLOW" Then
ActiveSheet.ChartObjects("YourChartName").Chart.FullSeriesCollection(1).Points(j).MarkerForegroundColor = RGB(255, 255, 0)

End If
End If
End If
End If

i = i + 1
j = j + 1

Loop



End Sub
相关问题
最新问题