Question

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

当x数据在列U中时，y数据在列V中，颜色数据在列T中如何创建不同的colourmap而不是顺序colourmap？

Answer 1

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

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

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

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

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

请注意，我在上面的行中添加了PtrSafe，因为这似乎使该函数适用于32位和64位版本的Excel。

通过一些实验，我发现您无法使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/引导我http://tools.medialab.sciences-po.fr/iwanthue/theory.php和https://vis4.net/blog/posts/mastering-multi-hued-color-scales/我意识到HSL空间中的插值也存在缺陷。在VBA中转换为CIE L*a*b* / HCL颜色空间，然后执行vis4.net建议的Bezier插值和亮度校正似乎太令人生畏了。所以我使用他们的 awesome 工具来设计一个颜色映射查找表：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 - ＆gt;从“文本”导入十六进制数字（空格分隔），将它们转换为A列，使用公式=MID(A1,2,6)沿着B列清除它们，然后使用公式{将RGB组件拆分为C-E列{1}}表示红色频道，=HEX2DEC(LEFT(B1,2))表示蓝色频道，=HEX2DEC(MID(B1,3,2))表示绿色频道。

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

=HEX2DEC(RIGHT(B1,2))

正确地导致了

现在将此颜色贴图应用于x-y-scatter图表，我编写了此代码

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

导致

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

请注意，对于拼图的最后一部分，您可能需要阅读Adding a color bar to a chart。

使用顺序或发散色标基于数据对图表的每个点着色

1 个答案: