在Excel 2010中，通过范围内的绝对值对单元格进行着色
我正在寻找颜色Excel 2010中的值的表格的绝对值。 基本上，如果我有桌子：
细胞被细胞的原始颜色着色。 我想要做的是颜色由单元格的绝对值 ，所以用这个表的单元格着色：
…但第一个表的值（真实值）。 任何想法如何可以做到这一点？ 通过GUI或与VBA？
我不认为有三种颜色（红色，黄色，绿色）可以做到这一点，但是你可以用两种颜色（例如黄色和绿色）来做到这一点。 简单地使低值的颜色和高值的颜色相同。 这样，绝对值较低的单元格将具有中间颜色，绝对值较高的单元格将具有其他颜色。
- select您的数据
- 条件格式
- 颜色比例
- 更多规则
- 在格式风格下select“三点比例”
- 改变颜色，使最大和最小颜色是相同的
这是我解决这个问题的方法。 条件格式公式读取
=AND(ABS(B3)>0,ABS(B3)<=500) 对于最黑的绿色，红色的比例尺会变成500到1000,1000到1500，最后是1500到2000。
条件格式
颜色比例值
这里是我用来testing这些条件格式的数据集的图片：
这个简单的条件格式插图的变体可能适合你。
突出显示整个数据范围（您需要最上面的LH单元格作为相对寻址的锚点），然后在“相对符号”中input公式：即没有美元符号的单元格引用。 你也必须考虑规则的顺序。
最上面的公式是模糊的，但读数=(ABS(B3)>39) * (ABS(B3)<41)注意，*符号应用AND运算。
我要从@barryleajo的回答中大量借用（如果你select了答案，不会伤害我的感觉）。 正如在答案中所述，条件格式化的顺序是关键，从最小的绝对值开始，然后继续前进。 答案和这个答案之间的区别在于，不需要使用“和”语句，因为OP似乎指示在一定范围的绝对值内的所有值应该接收相同的颜色格式。 这是一个小例子：
好吧，我有一个解决scheme，与3色调。 基本上你给我的代码提供一个区域。 然后创build两个范围，一个是负数，另一个是正数。 然后它应用条件格式
红 – 低黄 – 中绿 – 高到正范围和
红高黄 – 中绿 – 低到负范围。
这是一个快速的解决scheme，所以它的马虎，而不是健壮的（例如，它只适用于AZ列，因为懒惰ascii转换列号），但它的工作原理。 （我会张贴图片，但我没有足够的分数）
– – – – – – – – – – -编辑 – – – – – – – – – – – – – – —
@pnuts是正确的，除非数据是对称的这个解决scheme将不会正常工作。 所以考虑到这一点，我想出了一个新的解决scheme。 首先我将解释一般的想法，然后基本上只是转储代码，如果你明白的代码应该是相当清楚的逻辑。 对于这样一个看似简单的问题，这是一个相当复杂的解决scheme，但是并不总是这样吗？ 😛
我们仍然使用原始代码的基本思想，创build一个负范围，并应用颜色标度，然后创build一个正范围，并应用倒转的颜色标尺。 如下所示
负面……….. 0 …………….正面
绿黄色的红色 红黄绿色
所以我们的偏斜数据data_set = { – 1，-1，-2，-2，-2，-2，-3，-4，1,5，8，13}我所做的是反映极值。 在这种情况下，13现在data_set = { – 13，-1，-1，-2，-2，-2，-2，-3，-4,1,5,8,13}注意，额外的-13元件。 我假设你有一个button来制定这个macros，所以我将额外的-13存储在button下面的单元格中，即使它在那里是不可见的（是的，我知道他们可以移动button等，但它是我能想到的最简单的事情）
那么这是所有好的和良好的绿色地图13 AND -13，但颜色的梯度是基于百分比（实际上彩色条形码使用第50百分位确定中点，或在我们的情况下黄色部分）
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
所以我们的分布{-13，-1，-1，-2，-2，-2，-2，-3，-4,1,5,8,13}我们可以开始看到正范围内的黄色在8.5左右，因为8.5是第50百分位。 但在负范围（即使我们添加一个镜像-13）第50百分位是-2，所以我们在负范围的黄色将从2开始！ 很不理想。 就像提到的，但我们正在接近。 如果你有相当对称的数据这个问题将不会出现，但我们再次看到最差的情况下倾斜的数据集
我接下来做的是统计匹配的中点….或至less是他们的颜色。 因此，由于我们的极值（13）在正值范围内，我们将黄色保留在第50百分位，并尝试通过改变黄色出现的百分位来反映到负值范围（如果负范围具有极值，将黄色留在第50百分位，并试图将其reflection到正确的范围）。 这意味着在我们的负范围内，我们希望将黄色（第50百分位）从-2调整到-8.5左右的数字，以便匹配正范围。 我写了一个名为Function iGetPercentileFromNumber(my_range As Range, num_to_find As Double) ！ 更具体地说，它需要一个范围，并将值读取到一个数组中。 然后，它将num_to_find添加到数组中，并计算出num_to_find属于哪个百分点0-100（因此函数名中的i ）。 再次使用我们的示例数据，我们会调用类似的
imidcolorpercentile = iGetPercentileFromNumber(negrange with extra element -13, -8.5)
-8.5为负数（正范围的第50百分位数= 8.5）。 不要担心代码会自动提供范围和数字，这只是为了您的理解。 该函数将为我们的负值{-13，-1，-1，-2，-2，-2，-2，-3，-4，-8.5}的数组加上-8.5，然后找出它的百分数。
现在我们把这个百分点作为我们内部条件格式化的中点。 所以我们把黄色从第50百分位改成了
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
以我们的新价值
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = imidcolorpercentile 'was 50
现在歪斜的颜色！ 我们基本上已经创build了一个对称的外观颜色条。 即使我们的数字远非对称。
好吧，我知道这是一个TON来阅读和消化。 但这里是主要的外观这个代码 – 使用完整的三色条件格式（不是简单地设置两个极端颜色看起来像abs值） – 创build对称的颜色范围通过使用一个受阻的单元格（例如button下）来举行极端值 – 即使在偏斜的数据集中也使用统计分析来匹配颜色渐变
两个步骤都是必要的，而且它们本身都不足以创造真实的镜像色阶
由于这个解决scheme需要对数据集进行统计分析，所以每当你改变一个数字的时候，你都需要再次运行它（这实际上是以前的情况，我从来没有说过）
现在的代码。 把它放在vba或其他突出的程序。 这是几乎不可能读取….. 深呼吸
Sub main() Dim Rng As Range Dim Cell_under_button As String Set Rng = Range("A1:H10") 'change me!!!!!!! Cell_under_button = "A15" Call AbsoluteValColorBars(Rng, Cell_under_button) End Sub Function iGetPercentileFromNumber(my_range As Range, num_to_find As Double) If (my_range.Count <= 0) Then Exit Function End If Dim dval_arr() As Double 'this is one bigger than the range becasue we will add "num_to_find" to it ReDim dval_arr(my_range.Count + 1) Dim icurr_idx As Integer Dim ipos_num As Integer icurr_idx = 0 'creates array of all the numbers in your range For Each cell In my_range dval_arr(icurr_idx) = cell.Value icurr_idx = icurr_idx + 1 Next 'adds the number we are searching for to the array dval_arr(icurr_idx) = num_to_find 'sorts array in descending order dval_arr = BubbleSrt(dval_arr, False) 'if match_type is 0, MATCH finds an exact match ipos_exact = Application.Match(CLng(num_to_find), dval_arr, 0) 'there is a runtime error that can crop up when num_to_find isn't formated as long 'so we converted it, if it was a double we may not find an exact match so ipos_Exact 'may fail. now we have to find the closest numbers below or above clong(num_to_find) 'If match_type is -1, MATCH finds the value <= num_to_find ipos_small = Application.Match(CLng(num_to_find), dval_arr, -1) If (IsError(ipos_small)) Then Exit Function End If 'sorts array in ascending order dval_arr = BubbleSrt(dval_arr, True) 'now we find the index of our mid color point 'If match_type is 1, MATCH finds the value >= num_to_find ipos_large = Application.Match(CLng(num_to_find), dval_arr, 1) If (IsError(ipos_large)) Then Exit Function End If 'barring any crazy errors descending order = reverse order (ascending) so ipos_small = UBound(dval_arr) - ipos_small 'to minimize color error we pick the value closest to num_to_find If Not (IsError(ipos_exact)) Then 'barring any crazy errors descending order = reverse order (ascending) so 'since the index was WRT descending subtract that from the length to get ascending ipos_num = UBound(dval_arr) - ipos_exact Else If (Abs(dval_arr(ipos_large) - num_to_find) < Abs(dval_arr(ipos_small) - num_to_find)) Then ipos_num = ipos_large Else ipos_num = ipos_small End If End If 'gets the percentile as an integer value 0-100 iGetPercentileFromNumber = Round(CDbl(ipos_num) / my_range.Count * 100) End Function 'fairly well known algorithm doesn't need muxh explanation Public Function BubbleSrt(ArrayIn, Ascending As Boolean) Dim SrtTemp As Variant Dim i As Long Dim j As Long If Ascending = True Then For i = LBound(ArrayIn) To UBound(ArrayIn) For j = i + 1 To UBound(ArrayIn) If ArrayIn(i) > ArrayIn(j) Then SrtTemp = ArrayIn(j) ArrayIn(j) = ArrayIn(i) ArrayIn(i) = SrtTemp End If Next j Next i Else For i = LBound(ArrayIn) To UBound(ArrayIn) For j = i + 1 To UBound(ArrayIn) If ArrayIn(i) < ArrayIn(j) Then SrtTemp = ArrayIn(j) ArrayIn(j) = ArrayIn(i) ArrayIn(i) = SrtTemp End If Next j Next i End If BubbleSrt = ArrayIn End Function Sub AbsoluteValColorBars(Rng As Range, Cell_under_button As String) negrange = "" posrange = "" 'deletes existing rules Rng.FormatConditions.Delete 'makes a negative and positive range For Each cell In Rng If cell.Value < 0 Then ' im certain there is a better way to get the column character negrange = negrange & Chr(cell.Column + 64) & cell.Row & "," Else ' im certain there is a better way to get the column character posrange = posrange & Chr(cell.Column + 64) & cell.Row & "," End If Next cell 'removes trailing comma If Len(negrange) > 0 Then negrange = Left(negrange, Len(negrange) - 1) End If If Len(posrange) > 0 Then posrange = Left(posrange, Len(posrange) - 1) End If 'finds the data extrema most_pos = WorksheetFunction.Max(Range(posrange)) most_neg = WorksheetFunction.Min(Range(negrange)) 'initial values neg_range_percentile = 50 pos_range_percentile = 50 'if the negative range has the most extreme value If (most_pos + most_neg < 0) Then 'put the corresponding positive number in our obstructed cell Range(Cell_under_button).Value = -1 * most_neg 'and add it to the positive range, to reskew the data posrange = posrange & "," & Cell_under_button 'gets the 50th percentile number from neg range and tries to mirror it in pos range 'this should statistically skew the data the_num = WorksheetFunction.Percentile_Inc(Range(negrange), 0.5) pos_range_percentile = iGetPercentileFromNumber(Range(posrange), -1 * the_num) Else 'put the corresponding negative number in our obstructed cell Range(Cell_under_button).Value = -1 * most_pos 'and add it to the positive range, to reskew the data negrange = negrange & "," & Cell_under_button 'gets the 50th percentile number from pos range and tries to mirror it in neg range 'this should statistically skew the data the_num = WorksheetFunction.Percentile_Inc(Range(posrange), 0.5) neg_range_percentile = iGetPercentileFromNumber(Range(negrange), -1 * the_num) End If 'low red high green for positive range Call addColorBar(posrange, False, pos_range_percentile) 'high red low green for negative range Call addColorBar(negrange, True, neg_range_percentile) End Sub Sub addColorBar(my_range, binverted, imidcolorpercentile) If (binverted) Then 'ai -> array ints adcolor = Array(8109667, 8711167, 7039480) ' green , yellow , red Else adcolor = Array(7039480, 8711167, 8109667) ' red , yellow , greeb End If Range(my_range).Select 'these were just found using the record macro feature Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 'assigns a color for the lowest values in the range Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = adcolor(0) .TintAndShade = 0 End With 'assigns color to... midpoint of range Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = imidcolorpercentile 'originally 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = adcolor(1) .TintAndShade = 0 End With 'assigns colors to highest values in the range Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = adcolor(2) .TintAndShade = 0 End With End Sub