vba 如何根据列值为 xy 散点图中的点着色?

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/17194105/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 15:54:50  来源:igfitidea点击:

How can I color dots in a xy scatterplot according to column value?

excelvbaexcel-vbachartsexcel-formula

提问by Pr0no

Consider the following worksheet:

考虑以下工作表:

     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

I have used the scatterplot function in Excel to create the following chart:

我已经使用 Excel 中的散点图函数创建了以下图表:

enter image description here

在此处输入图片说明

However, each point in the chart has an additional property: GROUP. There are four groups: red, orange, blackand green. I would like to color each dot accordingly, so that I could perhaps see a pattern (group greenbeing almost always on the left side of the chart, for instance). Because my list is 500 rows long, I cannot do this manually. How can I do this automatically?

但是,图表中的每个点都有一个附加属性:GROUP。有四组:redorangeblackgreen。我想相应地为每个点着色,以便我可以看到一个模式(例如,组green几乎总是在图表的左侧)。因为我的列表有 500 行长,所以我无法手动执行此操作。我怎样才能自动执行此操作?

采纳答案by David Zemens

I answered a very similar question:

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

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

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

You simply need to iterate over the series' .Pointscollection, and then you can assign the points' .Format.Fill.ForeColor.RGBvalue based on whatever criteria you need.

您只需要遍历系列的.Points集合,然后您就可以.Format.Fill.ForeColor.RGB根据您需要的任何标准分配点的值。

UPDATED

更新

The code below will color the chart per the screenshot. This only assumes three colors are used. You can add additional case statements for other color values, and update the assignment of myColorto the appropriate RGB values for each.

下面的代码将根据屏幕截图为图表着色。这仅假设使用了三种颜色。您可以为其他颜色值添加额外的 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

回答by chancea

Non-VBA Solution:

非 VBA 解决方案:

You need to make an additional group of data for each color group that represent the Y values for that particular group. You can use these groups to make multiple data sets within your graph.

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

Here is an example using your data:

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

     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())

It should look like this afterwards:

之后应该是这样的:

     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

Now you can generate your graph using different data sets. Here is a picture showing just this example data:

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

enter image description here

在此处输入图片说明

You can change the series (X;Y)values to B:B ; E:E, B:B ; F:F, B:B ; G:Grespectively, to make it so the graph is automatically updated when you add more data.

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

回答by Andrew Blosfelds

If you code your x axis text categories, list them in a single column, then in adjacent columns list plot points for respective variables against relevant text category code and just leave blank cells against non-relevant text category code, you can scatter plot and get the displayed result. Any questions let me know. enter image description here

如果您对 x 轴文本类别进行编码,将它们列在单列中,然后在相邻列中针对相关文本类别代码列出各个变量的绘图点,并针对不相关的文本类别代码保留空白单元格,您可以散点图并得到显示的结果。有任何问题请告诉我。 在此处输入图片说明

回答by nicolas dejean

I see there is a VBA solution and a non-VBA solution, which both are really good. I wanted to propose my Javascript solution.

我看到有一个 VBA 解决方案和一个非 VBA 解决方案,它们都非常好。我想提出我的Javascript 解决方案

There is an Excel add-in called Funfunthat allows you to use javascript, HTML and css in Excel. It has an online editor with an embedded spreadsheet where you can build your chart.

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

I have written this code for you with Chart.js:

我已经用Chart.js为你编写了这段代码:

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

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

To create this chart, I entered my data on the spreadsheet and read it with a json file, it is the shortfile.

为了创建这个图表,我在电子表格上输入了我的数据并用一个 json 文件读取它,它是short文件。

I make sure to put it in the right format, in script.js, so I can add it to my chart:

我确保将其放入正确的格式中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]);
}

I then create the scatter chart with each dot having his designated color and position:

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

 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  
    });
  }

After I've created my scatter chart I can upload it in Excel by pasting the URL in the funfun Excel add-in. Here is how it looks like with my example:

创建散点图后,我可以通过在funfun Excel add-in 中粘贴 URL 将其上传到 Excel。这是我的示例的样子:

final

最终的

Once this is done You can change the color or the position of a dot instantly, in Excel, by changing the values in the spreadsheet.

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

If you want to add extra dots in the charts you just need to modify the radius of datain the shortjson file.

如果你想在图表中添加额外的点,你只需要修改的半径datashortJSON文件。

Hope this Javascript solutionhelps !

希望这个Javascript 解决方案有帮助!

Disclosure : I'm a developer of funfun

披露:我是 funfun 的开发者

回答by HelloKitty

Try this:

尝试这个:

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

回答by Jose Miguel Chaves Miranda

Recently I had to do something similar and I resolved it with the code below. Hope it helps!

最近我不得不做类似的事情,我用下面的代码解决了它。希望能帮助到你!

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