向图表添加颜色条

Question

如果我在Excel中创建x-y-scatter图并使用Coloring each point of a chart based on data using sequential or divergent color scales根据某些数据为点着色，如何在图表中添加颜色条以显示颜色比例？例如，像MATLAB的colorbar。

Answer 1

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

对于这个答案，我假设您使用this answer中的最后一个方法为数据着色。换句话说，在工作表的某个位置，您有一个超过3列的RGB三元组列表，每行1个颜色。所以像这个截图中的C - E列一样：

创建颜色条的策略是在空白纸上创建它，方法是将行高非常短的单元格的单元格背景着色以制作颜色条，然后使用单元格边框来制作刻度标记。刻度线标签将使用公式，以便颜色条是动态的。由于行高很小，一些单元被合并。所有这些都是由随后的宏自动完成的。然后，我们创建一个颜色条的链接图像，并在我们的图表上定位。

这是宏。您需要根据工作表进行一些更改。例如，在此宏中，定义着色的数据（因此不是颜色本身）位于Colour Map (Divergent)'!I:I范围内，您需要定义颜色条的最大值和最小值。对于不同的数据，您可能实际上想要使这些值相同（即选择绝对最大值和负值）。它还假设您的颜色三元组位于工作表C的{​​{1}} - E列中。

在新的空白纸上运行此宏：

Colour Map (Divergent)

这会在新工作表中创建以下内容：

注意我已将网格线重新放入此图像中，以说明此处发生的情况。但为了使其工作得很好，你必须关闭网格线，上面的代码为你做了。网格线显示颜色条是如何由一列单元格组成的，其背景颜色以非常小的行高度调整（B列）。勾选是使用合并单元格的单元格边框（列C）进行的，刻度线标签也使用以刻度线（D列）为中心的合并单元格。

现在突出显示新工作表的单元格Sub MakeColourBar() 'NB!!! Only run this on a blank sheet! 'NB!!! You need to put the min (Start), max (End) on the sheet yourself manually Range("A260").Value = "Start" Range("D260").Value = "=MIN('Colour Map (Divergent)'!I:I)" Range("A261").Value = "End" Range("D261").Value = "=MAX('Colour Map (Divergent)'!I:I)" Range("A262").Value = "Step" Range("D262").Value = "=(D261-D260)/8" Dim n as integer n = 256 'This assumes there are RGB colour data on another sheet. Change the sheet name and columns below as needed Dim sheetMap As Worksheet Set sheetMap = Worksheets("Colour Map (Divergent)") Dim row As Integer For row = 1 To 256 Range("B" & row + 1).Interior.color = RGB(sheetMap.Range("C" & n - row + 1).Value, sheetMap.Range("D" & n - row + 1).Value, sheetMap.Range("E" & n - row + 1).Value) Next row ActiveWindow.DisplayGridlines = False Rows("2:257").RowHeight = 2 Rows("1:1").RowHeight = 7.5 'This is for the tick mark labels Rows("258:258").RowHeight = 7.5 'This is for the tick mark labels Columns("B:B").ColumnWidth = 2.14 With Range("B2:B257") .Borders(xlEdgeTop).Weight = xlMedium .Borders(xlEdgeRight).Weight = xlMedium .Borders(xlEdgeBottom).Weight = xlMedium .Borders(xlEdgeLeft).Weight = xlMedium End With Range("D1:D6").Merge Range("D1").Value = "=D261" Range("D253:D258").Merge Range("D253").Value = "=D260" 'Merge rows for tick marks Dim mark As Integer For mark = 1 To 8 Range("C" & (mark - 1) * (256 / 8) + 2 & ":C" & (mark) * (256 / 8) + 1).Merge Range("C" & (mark - 1) * (256 / 8) + 2).Borders(xlEdgeTop).Weight = xlMedium 'Make the tick mark labels by merging the 10 cells in column D that center around each tick label If mark > 1 Then Range("D" & (mark - 1) * (256 / 8) + 2 - 5 & ":D" & (mark - 1) * (256 / 8) + 2 + 4).Merge Range("D" & (mark - 1) * (256 / 8) + 2 - 5).Value = "=D" & (mark) * (256 / 8) + 2 - 5 & " + D262" End If Next mark Range("C257").Borders(xlBottom).Weight = xlMedium Columns("C:C").ColumnWidth = 0.42 Columns("D:D").VerticalAlignment = xlCenter Columns("D:D").HorizontalAlignment = xlLeft End Sub ，复制，然后在工作表上将图表粘贴作为链接图像：

在图表上，调整绘图区域的大小以在图表区域右侧显示一些空白区域：

然后最后调整链接图像的大小（确保保持纵横比不变！）并将其放置在此空白区域中。然后，您可以调整新颜色条表的列B3:D258的字体大小，以使数字大小与图表上的数字大小相匹配。

最终结果：