使用顺序或不同的颜色比例基于数据着色图表的每个点

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

如果x数据在列U中，则y数据在列V中，并且颜色数据在列T中。我如何创build发散式色彩映射而不是顺序色彩映射？

Answer 1

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

---

如果您的颜色数据只有一些离散值，最简单的方法就是将其绘制为不同的系列，如下所示 。 但是，如果您有顺序数据，则需要使用VBA循环访问数据系列的每个点并更改其颜色。

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

幸运的是，您可以公开一个API函数将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)的色调值ColorHLSToRGB(161, normalize(datum, dataMin, dataMax), 220) 161 ，饱和度值ColorHLSToRGB(161, normalize(datum, dataMin, dataMax), 220) 220 。 我从颜色select器中获取这些值，从基本颜色开始，然后select更多的颜色，然后将下拉（以红色突出显示）从RGB更改为HSL。 另外请注意，右边的从黑色到蓝色到白色的条形图是仅通过变化的亮度获得的颜色映射。

顺便说一句，如果你想适应这个不同的数据，我build议将归一化函数的范围从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.netbuild议的Bezier插值和亮度校正似乎太令人生畏。 所以相反，我用他们的真棒工具来devise一个彩色地图查找表： 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插值有更多的感知线性。 请注意，我试图select颜色，使亮度图（颜色栏下面的黑色对angular线）大致对称，使感知的亮度映射到绝对值）

第一步是复制第一个hex数字块并保存为文本文件：

然后在Excel中，我使用数据 – >从文本导入hex数字（空格分隔），调换他们去列A，清理它们使用公式=MID(A1,2,6)沿列B，然后拆分使用公式=HEX2DEC(LEFT(B1,2))为红色通道， =HEX2DEC(MID(B1,3,2))为蓝色通道，并且=HEX2DEC(RIGHT(B1,2))为绿色通道。

然后，我使用这个VBA代码，通过在G列的单元格中着色来testing这些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 

这导致了正确的

现在把这张彩色贴图应用到一个xy-scatter图表上，我写了这个代码

 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 

这导致了

缺点是你的色彩映射存储在你的工作表中（尽pipe你可以把它作为一个VBA数组来存储），但是最后你应该得到一个知觉统一的颜色映射，因此对解释数据更有用。

请注意，对于拼图的最后一部分，您可能需要阅读将颜色条添加到图表 。