问题描述
如何根据电子表格中的值对散点图上的各个点进行着色？例如，如何创建以下图表：
其中x数据在列U中，y数据在列V中，颜色数据在列T
中如何创建发散色彩图而不是顺序色彩？
如果你的颜色数据只有几个离散值，最简单的方法是绘制为不同的系列
幸运的是，您可以
顺便说一下，如果你想对此进行适应发散数据，我建议将标准化函数从240下降到120（因此240低值，这样它的白色接近零），然后适应代码这样的东西（注意代码假设数据发散在 0 ，但你可以随时更改）：
函数normalizeDivergent（datum As Variant，dataMin As Double，dataMax As Double）As Integer
normalizeDivergent = 240 - CInt （（datum-dataMin）/（dataMax-dataMin））* 121）
结束函数
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
使用工作表（Sheet1）。ChartObjects（Chart 1）。Chart.FullSeriesCollection（1）
Dim Count As Integer
For Count = 1到UBound（数据）
datum = data（Count，1）
如果datum> 0 Then
.Points（Count）.Format.Fill.BackColor.rgb = ColorHLSToRGB（161，normalizeDivergent（datum，dataMin，dataMax），220）
Else
。 Format.Fill.BackColor.rgb = ColorHLSToRGB（0，normalizeDivergent（-datum，dataMin，dataMax），220）
结束如果
下一个计数
结束于
End Sub
这会产生
$ b b
EDIT：
阅读这篇优秀文章后：
然后在Excel中我使用DATA - >从文本导入十六进制数字（空格分隔），将它们转置到A列，使用公式 = MID（A1,2,6）下行列B，然后使用公式 = HEX2DEC（LEFT（B1,2））将RGB分量拆分为列C - E 代表红色通道， = HEX2DEC（MID（B1,3,2））代表蓝色通道， = HEX2DEC （RIGHT（B1,2））为绿色通道。
然后我测试这些RGB值， VBA代码：
Sub makeColourBar（）
Dim row As Integer
对于row = 1到255
Range（G& row）.Interior.color = rgb（Range（C& row）.Value，Range（D& row）.Value，Range（E& row）.Value）
row
End Sub
正确输入
现在，将此颜色贴图应用于xy-scatter图表。 p>
函数normalizeLookUp（datum As Variant，dataMin As Double，dataMax As Double，n As Integer）As Integer
normalizeLookUp = CInt （（datum-dataMin）/（dataMax-dataMin））*（n-1））+ 1
结束函数
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
使用工作表（Color Map）。ChartObjects（Chart 1）。Chart.FullSeriesCollection b
$ b 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）
下一计数
结束于
b $ b End Sub
这会导致
缺点是你的彩色地图存储在你的一张工作表上（虽然你可以把它存为一个VBA数组），但最终你应该得到一个颜色映射，感觉上是均匀的，因此更有用于解释数据。
请注意，对于最后一块拼图中，您可能需要阅读。
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:
Where the x-data are in column U, the y-data are in column V and the colour data are in column THow can I create a divergent colourmap instead of a sequential one?
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:
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.
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
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:
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
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
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.
这篇关于基于使用顺序或发散颜色标度的数据对图表的每个点着色的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！