Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
681 views
in Technique[技术] by (71.8m points)

excel - Coloring each point of a chart based on data using sequential or divergent color scales

How can I colour the individual points on a scatter chart based on values in my spreadsheet? For example, how can I create the following chart:

enter image description here

Where the x-data are in column U, the y-data are in column V and the colour data are in column T How can I create a divergent colourmap instead of a sequential one?

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

Full example on GitHub: https://github.com/DanGolding/Scatter-plot-with-color-grading-in-Excel


If your colour data have only a few discrete values, the easiest way is to plot it as different series as shown here. However, if you have sequential data, you will need to use VBA to loop through each point of the data series and change its colour.

Using the macro editor, it is fairly easy to find the code to change the colour of an individual marker. You can then modify it to fit in a loop. This code is shown later. The challenge is to now choose a good colour mapping. This answer provides code that creates a mapping that is a gradient from one colour to another by a simple linear modulation of the individual RGB channels. However, I find that a more natural mapping for sequential data is to hold the hue and saturation of the colour constant and then vary lightness/luminace channel. This is, for example, how Excel varies the standard colours in the colour picker:

enter image description here

Luckily, you can expose an API function to convert from the HLS colour space to the RGB colourspace required to set the colour of a marker. To do this, add the following line of code to the top of your module:

Public Declare PtrSafe Function ColorHLSToRGB Lib "shlwapi.dll" (ByVal wHue As Long, ByVal wLuminance As Long, ByVal wSaturation As Long) As Long

Note that I have added PtrSafe in the line above as this seems to make the function work with both 32-bit and 64-bit versions of Excel.

Through some experimentation, I found that you can't make the wLuminance channel higher than 240 so I use the following function to map our colouring data (column T in the question) to range from 0 to 240:

Function normalize(datum As Variant, dataMin As Double, dataMax As Double) As Integer
    normalize = CInt(((datum - dataMin) / (dataMax-dataMin)) * 241)
End Function

The final code to colour the chart is

Sub colourChartSequential()

    Dim data As Variant
    Dim dataMin As Double
    Dim dataMax As Double

    data = Range("T1:T50") 'Modify this as needed, probably to be more dynamic
    dataMin = WorksheetFunction.min(data) 'Note this doesn't work if your data are formatted as dates for some reason...
    dataMax = WorksheetFunction.max(data)

    With Worksheets("Sheet1").ChartObjects("Chart 1").Chart.FullSeriesCollection(1) 'Change "Chart 1" to the name of your chart

        Dim Count As Integer
        For Count = 1 To UBound(data)
             datum = data(Count, 1)
             .Points(Count).Format.Fill.BackColor.rgb = ColorHLSToRGB(161, normalize(datum, dataMin, dataMax), 220)
        Next Count

    End With

End Sub

Note that I called ColorHLSToRGB(161, normalize(datum, dataMin, dataMax), 220) with a hue value of 161 and a saturation value of 220. I got these values from the colour picker by starting from a base colour, then choosing more colours and then changing the drop down (highlighted in red below) from RGB to HSL. Also note that the bar that ranges from black through blue to white on the right is the colour mapping you get by only varying luminance.

enter image description here

By the way, if you want to adapt this for divergent data, I suggest chanding the normalization function to range from 240 down to 120 (so 240 for low values so that it's white near zero) and then adapting the code to something like this (note the codes assumes the data diverge around 0 but you can always change that):

Function normalizeDivergent(datum As Variant, dataMin As Double, dataMax As Double) As Integer
    normalizeDivergent = 240 - CInt(((datum - dataMin) / (dataMax - dataMin)) * 121)
End Function

Sub colourChartDivergent()

    Dim data As Variant
    Dim dataMin As Double
    Dim dataMax As Double

    Dim lastRow As Integer
    lastRow = Range("T1").End(xlDown).row
    data = Range("T1:T" & lastRow)
    dataMin = WorksheetFunction.min(data)
    dataMax = WorksheetFunction.max(data)

    dataMax = WorksheetFunction.max(dataMax, -dataMin)
    dataMin = 0

    With Worksheets("Sheet1").ChartObjects("Chart 1").Chart.FullSeriesCollection(1)

        Dim Count As Integer
        For Count = 1 To UBound(data)
             datum = data(Count, 1)

            If datum > 0 Then
                .Points(Count).Format.Fill.BackColor.rgb = ColorHLSToRGB(161, normalizeDivergent(datum, dataMin, dataMax), 220)
            Else
                .Points(Count).Format.Fill.BackColor.rgb = ColorHLSToRGB(0, normalizeDivergent(-datum, dataMin, dataMax), 220)
            End If
        Next Count

    End With

End Sub

Which produces something like

enter image description here

EDIT:

After reading this excellent article: http://vis4.net/blog/posts/avoid-equidistant-hsv-colors/ which lead me to http://tools.medialab.sciences-po.fr/iwanthue/theory.php and https://vis4.net/blog/posts/mastering-multi-hued-color-scales/ I realised that interpolating in the HSL space is also flawed. Converting to CIE L*a*b* / HCL colour spaces in VBA and then performing the Bezier interpolation and lightness correction suggested by vis4.net seemed too daunting. So instead I used their awesome tool to design a colour map look up table: http://gka.github.io/palettes/#diverging|c0=DarkRed,LightSalmon,white|c1=white,PaleTurquoise,MediumBlue|steps=255|bez0=1|bez1=1|coL0=1|coL1=1 that is hopefully more perceptually linear than my original HSL interpolation. Note that I tried to choose colour so that the lightness graph (the black diagonal lines below the colour bar) was roughly symmetrical so that perceived lightness maps to absolute value)

Step one is to copy the first block of hex numbers and save them as a text file:

enter image description here

Then in Excel I used DATA -> From Text to import the hex numbers (space delimited), transposed them to go down column A, cleaned them up using the formula =MID(A1,2,6) going down column B and then split the RGB components into columns C - E using the formulae =HEX2DEC(LEFT(B1,2)) for the red channel, =HEX2DEC(MID(B1,3,2)) for the blue channel and =HEX2DEC(RIGHT(B1,2)) for the green channel.

I then tested these RGB values by colouring in cells in column G using this VBA code:

Sub makeColourBar()
    Dim row As Integer
    For row = 1 To 255
        Range("G" & row).Interior.color = rgb(Range("C" & row).Value, Range("D" & row).Value, Range("E" & row).Value)
    Next row
End Sub

which resulted correctly in

enter image description here

Now to apply this colour map to an x-y-scatter chart I wrote this code

Function normalizeLookUp(datum As Variant, dataMin As Double, dataMax As Double, n As Integer) As Integer
    normalizeLookUp = CInt(((datum - dataMin) / (dataMax - dataMin)) * (n - 1)) + 1
End Function

Sub colourChartLookUp()

    Dim data As Variant
    Dim dataMin As Double
    Dim dataMax As Double

    Dim lastRow As Integer
    lastRow = Range("H1").End(xlDown).row
    data = Range("H1:H" & lastRow)
    dataMin = WorksheetFunction.min(data)
    dataMax = WorksheetFunction.max(data)

    dataMax = WorksheetFunction.max(dataMax, -dataMin)
    dataMin = -dataMax

    With Worksheets("Colour Map").ChartObjects("Chart 1").Chart.FullSeriesCollection(1)

        Dim Count As Integer
        Dim colourRow As Integer
        For Count = 1 To UBound(data)
             datum = data(Count, 1)
                colourRow = normalizeLookUp(datum, dataMin, dataMax, 255)
                .Points(Count).Format.Fill.BackColor.rgb = rgb(Range("C" & colourRow).Value, Range("D" & colourRow).Value, Range("E" & colourRow).Value)
        Next Count

    End With

End Sub

which results in

enter image description here

The downside is that your colour map is stored on one of your worksheets (although you could store it as a VBA array instead) but in the end you should get a colour mapping that is perceptually uniform and thus more useful for interpreting data.

Note that for the final piece of the puzzle, you might want to read Adding a color bar to a chart.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...