62

次のワークシートを検討してください。

     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、 の4 つのグループがありblackますgreen。それに応じて各ドットに色を付けて、おそらくパターンを確認できるようにしたいと思います (たとえば、グループgreenはほとんど常にチャートの左側にあります)。私のリストは 500 行の長さなので、これを手動で行うことはできません。どうすればこれを自動的に行うことができますか?

4

6 に答える 6

22

私は非常によく似た質問に答えました：

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
于 2013-06-19T15:48:01.613 に答える
3

x 軸のテキスト カテゴリをコーディングし、それらを 1 つの列にリストしてから、隣接する列に、関連するテキスト カテゴリ コードに対してそれぞれの変数のプロット ポイントをリストし、関連しないテキスト カテゴリ コードに対して空白のセルをそのままにしておくと、プロットを散布して取得できます。表示された結果。ご不明な点がございましたら、お知らせください。 ここに画像の説明を入力

于 2018-08-08T02:14:52.003 に答える
1

これを試して：

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
于 2015-06-16T10:20:53.827 に答える
1

最近、似たようなことをしなければならなかったので、以下のコードで解決しました。それが役に立てば幸い！

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
于 2017-11-07T17:32:47.133 に答える