使用顺序或发散色标根据数据为图表的每个点着色

Question

如何根据电子表格中的值为散点图上的各个点着色？例如，如何创建以下图表：

其中 x 数据在 U 列，y 数据在 V 列，颜色数据在 T 列我怎样才能创建不同的颜色映射而不是连续的颜色映射？

Answer 1

GitHub 上的完整示例：https://github.com/DanGolding/Scatter-plot-with-color-grading-in-Excel

如果您的颜色数据只有几个离散值，最简单的方法是将其绘制为不同的系列 as shown here。但是，如果您有顺序数据，则需要使用 VBA 遍历数据系列的每个点并更改其颜色。

使用宏编辑器，很容易找到更改单个标记颜色的代码。然后您可以修改它以适应循环。此代码稍后显示。现在的挑战是选择一个好的颜色映射。提供了创建映射的代码，该映射是通过单个 RGB 通道的简单线性调制从一种颜色到另一种颜色的渐变。但是，我发现顺序数据的更自然映射是保持颜色的色调和饱和度不变，然后改变 lightness/luminace 通道。这是，例如，Excel 如何改变颜色选择器中的标准颜色：

幸运的是，您可以expose an API function将 HLS 颜色 space 转换为设置标记颜色所需的 RGB 颜色space。为此，请将以下代码行添加到模块的顶部：

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

请注意，我在上面的行中添加了 PtrSafe，因为这似乎使该函数适用于 Excel.

的 32 位和 64 位版本

通过一些实验，我发现 wLuminance 通道不能高于 240 所以我使用以下函数将我们的着色数据（问题中的 T 列）映射到范围从 0 到 240:

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

为图表着色的最终代码是

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

请注意，我调用了 ColorHLSToRGB(161, normalize(datum, dataMin, dataMax), 220)，色调值为 161，饱和度值为 220。我从颜色选择器中获取这些值，方法是从一种基色开始，然后选择更多颜色，然后将下拉列表（下面以红色突出显示）从 RGB 更改为 HSL。另请注意，右侧从黑色到蓝色再到白色的条形图是您仅通过改变亮度获得的颜色映射。

顺便说一下，如果你想针对不同的数据调整它，我建议将标准化函数的范围从 240 降低到 120（所以 240 是低值，所以它在零附近是白色的）然后调整代码像这样（注意代码假定数据在 0 附近发散，但您可以随时更改它）：

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

产生类似

的东西

编辑：

阅读这篇优秀文章后：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 希望它比我原来的 HSL 插值在感知上更线性。请注意，我尝试选择颜色以使亮度图（颜色条下方的黑色对角线）大致对称，以便感知亮度映射到绝对值）

第一步是复制第一个十六进制数块并将它们保存为文本文件：

然后在 Excel 中，我使用 DATA -> From Text 导入十六进制数字（space 分隔），将它们转置到 A 列中，使用公式 [=25 清理它们=] 沿着 B 列向下移动，然后使用公式 =HEX2DEC(LEFT(B1,2)) 表示红色通道，=HEX2DEC(MID(B1,3,2)) 表示蓝色通道，=HEX2DEC(RIGHT(B1,2)) 表示绿色通道，将 RGB 分量拆分为 C - E 列。

然后我通过使用此 VBA 代码在 G 列的单元格中着色来测试这些 RGB 值：

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

结果正确

现在要将此颜色图应用到我编写此代码的 x-y 散点图

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

结果是

缺点是您的颜色映射存储在您的一个工作表中（尽管您可以将其存储为 VBA 数组）但最后您应该得到一个感知上统一且因此对解释数据更有用。

请注意，对于拼图的最后一块，您可能需要阅读。

使用顺序或发散色标根据数据为图表的每个点着色

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

excel

charts

scatter-plot

colormap

vba