次のワークシートを検討してください。
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の散布図関数を使用して、次のグラフを作成しました。
ただし、チャートの各ポイントには、GROUP
という追加のプロパティがあります。 red
、orange
、black
、およびgreen
の4つのグループがあります。それに応じて各ドットに色を付けたいので、おそらくパターンを見ることができます(たとえば、グループgreen
は、ほとんど常にチャートの左側にあります)。リストの長さは500行なので、これを手動で行うことはできません。どうすれば自動的にこれを行うことができますか?
よく似た質問に答えました。
https://stackoverflow.com/a/15982217/1467082
シリーズの.Points
コレクションを反復処理するだけで、必要な基準に基づいてポイントの.Format.Fill.ForeColor.RGB
値を割り当てることができます。
更新済み
以下のコードは、スクリーンショットごとにチャートに色を付けます。これは、3色のみが使用されることを前提としています。他の色の値に追加のcaseステートメントを追加し、myColor
の割り当てをそれぞれの適切なRGB値に更新できます。
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
特定のグループの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
これで、異なるデータセットを使用してグラフを生成できます。このサンプルデータのみを示す画像を次に示します。
系列(X;Y)
値をそれぞれB:B ; E:E
、B:B ; F:F
、B:B ; G:G
に変更して、データを追加するとグラフが自動的に更新されるようにすることができます。
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アドイン にURLを貼り付けて、Excelにアップロードできます。私の例では次のようになります。
これが完了すると、スプレッドシートの値を変更することにより、Excelで即座に色またはドットの位置を変更できます。
チャートに余分なドットを追加する場合は、data
jsonファイルのshort
の半径を変更するだけです。
このJavascriptソリューションが役立つことを願っています!
開示:私はfunfunの開発者です
最近、私は似たようなことをしなければならなかったので、以下のコードで解決しました。それが役に立てば幸い!
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
これを試して:
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