使用vba创build“色阶”（避免条件格式化）

我正在寻找一种方法来通过VBA代码将颜色比例应用于一组单元格， 但不是通过应用某些条件格式…我想将它们应用为静态颜色（InteriorColor）

我搜查了很多的Excel网站，谷歌和stackoverflow，并没有发现:(

对于我的情况，如果你看下面的图片：

你可以看到我已经给它一个色阶，在这个例子中，虽然我已经通过条件格式完成了色阶。 我想通过VBA创build色阶， 但是必须避免使用条件格式 ，我想给单元格分配内部颜色，以便颜色是静态的，这使得它们在所有移动的Excel查看器中都可见，更快，不会改变，如果我是删除任何数字/行。

下面是一些示例数据只需将其保存在csv中，然后在Excel中打开即可查看excel中的数据：P ：

Data 1 (Yes there are blanks),Data 2,Data 3,Data 4,Data 5,Data 6 155.7321504,144.6395913,1,-4,-9.3844,0.255813953 113.0646481,120.1609771,5,-2,-2.5874,0.088082902 126.7759917,125.3691519,2,0,-0.0004,0.107843137 ,0,7,,,0.035714286 123.0716084,118.0409686,4,0,0.3236,0.118881119 132.4137536,126.5740362,3,-2,-3.8814,0.090909091 70,105.9874422,6,-1,-0.3234,0.103896104 

我在python中使用了下面的代码，但显然我不能在VBA中使用这个代码 ，下面的代码成功地将hex颜色分配给50个颜色的预定义数组中的数字，所以非常准确。

 def mapValues(values): nValues = np.asarray(values, dtype="|S8") mask = (nValues != '') maskedValues = [float(i.split('%')[0]) for i in nValues[mask]] colorMap = np.array(['#F8696B', '#F86E6C', '#F8736D', '#F8786E', '#F97E6F', '#F98370', '#F98871', '#FA8E72', '#FA9373', '#FA9874', '#FA9E75', '#FBA376', '#FBA877', '#FBAD78', '#FCB379', '#FCB87A', '#FCBD7B', '#FCC37C', '#FDC87D', '#FDCD7E', '#FDD37F', '#FED880', '#FEDD81', '#FEE382', '#FEE883', '#FCEB84', '#F6E984', '#F0E784', '#E9E583', '#E3E383', '#DCE182', '#D6E082', '#D0DE82', '#C9DC81', '#C3DA81', '#BDD881', '#B6D680', '#B0D580', '#AAD380', '#A3D17F', '#9DCF7F', '#96CD7E', '#90CB7E', '#8ACA7E', '#83C87D', '#7DC67D', '#77C47D', '#70C27C', '#6AC07C', '#63BE7B']) _, bins = np.histogram(maskedValues, 49) try: mapped = np.digitize(maskedValues, bins) except: mapped = int(0) nValues[mask] = colorMap[mapped - 1] nValues[~mask] = "#808080" return nValues.tolist() 

任何人有任何想法或有任何人以前用VBA做过这个。

Answer 1

下面的函数CalcColorScale将返回给定任意两种颜色和比例的颜色。比例是当前数据相对于数据范围的值。 例如，如果你的数据是从0到200，那么数据值100就是50％（.5）

图像显示红色和蓝色之间缩放的结果

 Public Sub Test() ' Sets cell A1 to background purple Sheet1.Range("A1").Interior.Color = CalcColorScale(rgbRed, rgbBlue, 0.5) End Sub ' color1: The starting color as a long ' color2: The end color as a long ' dScale: This is the percentage in decimal of the color. Public Function CalcColorScale(color1 As Long, color2 As Long, dScale As Double) As Long ' Convert the colors to red, green, blue components Dim r1 As Long, g1 As Long, b1 As Long r1 = color1 Mod 256 g1 = (color1 \ 256) Mod 256 b1 = (color1 \ 256 \ 256) Mod 256 Dim r2 As Long, g2 As Long, b2 As Long r2 = color2 Mod 256 g2 = (color2 \ 256) Mod 256 b2 = (color2 \ 256 \ 256) Mod 256 CalcColorScale = RGB(CalcColorScaleRGB(r1, r2, dScale) _ , CalcColorScaleRGB(g1, g2, dScale) _ , CalcColorScaleRGB(b1, b2, dScale)) End Function ' Calculates the R,G or B for a color between two colors based the percentage between them ' eg .5 would be halfway between the two colors Public Function CalcColorScaleRGB(color1 As Long, color2 As Long, dScale As Double) As Long If color2 < color1 Then CalcColorScaleRGB = color1 - (Abs(color1 - color2) * dScale) ElseIf color2 > color1 Then CalcColorScaleRGB = color1 + (Abs(color1 - color2) * dScale) Else CalcColorScaleRGB = color1 End If End Function 

Answer 2

你总是可以使用python脚本来生成基于csv数据的hex颜色，然后简单地读取包含生成的hex颜色的csv文件，然后转换rgb，然后将interiorcolor设置为rgb结果的内部颜色。

 Sub HexExample() Dim i as Long Dim LastRow as Long LastRow = Range("A" & Rows.Count).End(xlUp).Row For i = 1 To LastRow Cells(i, "B").Interior.Color = HexConv(Cells(i, "A")) Next End Sub Public Function HexConv(ByVal HexColor As String) As String Dim Red As String Green As String Blue As String HexColor = Replace(HexColor, "#", "") Red = Val("&H" & Mid(HexColor, 1, 2)) Green = Val("&H" & Mid(HexColor, 3, 2)) Blue = Val("&H" & Mid(HexColor, 5, 2)) HexConv = RGB(Red, Green, Blue) End Function 

Answer 3

也许这是你在找什么：

 Sub a() Dim vCM As Variant vCM = Array("F8696B", "FED880", "63BE7B") ' as many as you need ' Array's lower bound is 0 unless it is set to another value using Option Base ActiveCell.Interior.Color = Application.WorksheetFunction.Hex2Dec(CStr(vCM(2))) ' off-green in the active cell End Sub 

如果你想放弃hex，并使用颜色值，那么上面就成了这个

 Sub b() Dim vCM As Variant vCM = Array(16279915, 16701568, 6536827) ' as many as you need ' Array's lower bound is 0 unless it is set to another value using Option Base ActiveCell.Interior.Color = vCM(2) ' 6536827 setts an off-green in the active cell End Sub 

如果你不知道如何获取颜色值，这里是手动过程：

1. 将内部颜色应用于单元格。 确保单元格被选中。

2. 在VBE的“即时”窗口中，执行?ActiveCell.Interior.Color获取您在步骤1中应用的内部颜色的颜色编号。

祝你好运。

Answer 4

假设：

A1：A40中的值。

 Sub M_snb() [a1:A40] = [if(A1:A40="",0,A1:A40)] sn = [index(rank(A1:A40,A1:A40),)] For j = 1 To UBound(sn) If Cells(j, 1) <> 0 Then Cells(j, 1).Interior.Color = RGB(Int(sn(j, 1) * 255 / 40), Abs(sn(j, 1) > UBound(sn) \ 2), 255 - Int((sn(j, 1) - 1) * (255 / 40))) Next [a1:A40] = [if(A1:A40=0,"",A1:A40)] End Sub 

Answer 5

我设法find了正确的答案，实际上很简单。 您只需添加条件格式，然后将.Interior.Color设置为与.DisplayFormat.Interior.Color相同，然后删除条件格式。

这将完成主要职位所要求的内容; 如果你想做一个后备，那就不要删除条件格式。

 ' Select Range Range("A2:A8").Select ' Set Conditional Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With ' Set Static For i = 1 To Selection.Cells.Count Selection.Cells(i).Interior.Color = Selection.Cells(i).DisplayFormat.Interior.Color Next ' Delete Conditional Selection.Cells.FormatConditions.Delete 

希望这有助于未来的人。