Цвет ячеек по абсолютному значению в диапазоне в Excel 2010
Я ищу цвет таблицы значений в Excel 2010 по их абсолютному значению. В принципе, если у меня есть таблица:
...клетки окрашены сырой стоимостью клетки. То, что я хотел бы сделать, это цвет по ячейке абсолютное значение, поэтому с окраской ячейки этой таблицы:
...но со значениями первой таблицы (реальными значениями). Есть идеи, как это сделать? Через GUI или с VBA?
5 ответов
Я не думаю, что есть какой-либо способ сделать это с тремя цветами (красный, желтый, зеленый), но вы можете сделать это с двумя цветами (например, желтый и зеленый). Просто сделайте цвет для низкого значения и цвет для высокого значения одинаковым. Таким образом, ячейки с более низким абсолютным значением будут иметь средний цвет, а ячейки с более высоким абсолютным значением-другой цвет.
- выберите
- Условное Форматирование
- цвета Масштаб
- Правила
- выберите "3-точечная шкала" в разделе Стиль формата
- измените цвета так, чтобы максимальные и минимальные цвета были одинаковыми
вот мое решение этой проблемы. Формула условного формата гласит
=AND(ABS(B3)>0,ABS(B3)<=500)
для самого темного зеленого цвета масштаб изменяется на 500 до 1000, 1000 до 1500 и, наконец, 1500 до 2000 для красной полосы.
Условные Форматы
Значения Цветовой Шкалы
вот картинка из набора данных, который я использовал для проверки этих условных форматов:
вариант этой простой иллюстрации условного форматирования может работать для вас.
выделите весь диапазон данных (нужен верхняя левая клетка, чтобы быть якорем для относительной адресации) и введите формулу: в относительной нотации, т. е. ссылки на ячейки без знаков доллара. Вы также должны учитывать порядок правил.
самая верхняя формула затемнена, но читается =(ABS(B3)>39) * (ABS(B3)<41) обратите внимание, что символ * применяется и операция.
Я собираюсь сильно заимствовать из ответа @barryleajo (не повредит моим чувствам, если вы выберете этот ответ). Как было указано в этом ответе, порядок условного форматирования является ключевым, начните с наименьших абсолютных значений и продвигайтесь вверх. Разница между этим ответом и этим заключается в том, что нет необходимости использовать оператор "и", поскольку OP, похоже, указывает, что все значения в определенном диапазоне абсолютных значений должны получать один и тот же цветовой формат. Вот небольшой пример:
Ок, у меня есть решение, которое работает с цветом 3-зонный. В основном вы предоставляете область моему коду. Затем он создает два диапазона: один из чисел neg и один из положительных. Затем применяется условное форматирование
красный-низкий, желтый-средний, зеленый-высокий положительный диапазон и
красный-высокий, желтый-средний, зеленый-низкий в отрицательном диапазоне.
это было быстрое решение, поэтому его небрежный и не надежный (например, он работает только в Столбцах A-Z из-за ленивое преобразование ascii для номеров столбцов), но оно работает. (я бы разместил фотографию, но у меня недостаточно очков)
---------------------изменить-------------------------------
@pnuts прав, если данные не симметричны, это решение не будет работать так, как есть. поэтому, имея это в виду, я придумал новое решение. Сначала я объясню общую идею, затем в основном просто дамп кода, если вы понимаете логику, код должен быть довольно ясным. Это довольно сложное решение для такой, казалось бы, простая проблема, но это не всегда так? :- P
мы все еще используем основную идею исходного кода, создаем отрицательный диапазон и применяем к нему цветовую шкалу, затем создаем положительный диапазон и применяем к нему перевернутую цветовую шкалу. Как видно ниже
отрицательный ........... 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 элемент. Я предполагаю, что у вас есть кнопка для ввода этого макроса, поэтому я храню extra -13 в ячейке, которая находится под кнопкой, поэтому, хотя ее там не видно (да, я знаю, что они могут перемещать кнопку и т. д., Но это было проще всего мог подумать)
Ну, это все хорошо и хорошо зеленые карты до 13 и -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-й процентиль. но в диапазоне neg (даже если мы добавим зеркальный -13) 50-й процентиль равен -2, поэтому наш желтый цвет в отрицательном диапазоне начнется с 2!! Вряд ли идеальный. как уже говорилось пнуц, но мы становимся ближе. если у вас есть довольно симметричные данные, эта проблема не будет присутствовать, но опять же мы смотрим на худший случай искаженных наборов данных
то, что я сделал дальше, статистически соответствует средним точкам....или, по крайней мере, их цвета. Поэтому, поскольку наше экстремальное значение (13) находится в положительном диапазоне, мы оставляем желтый цвет на 50-м процентиле и пытаемся отразите его в отрицательном диапазоне, изменив, в каком процентиле появляется желтый цвет (если бы отрицательный диапазон имел экстремальное значение, мы бы оставили желтый в этом 50-м процентиле и попытались отразить его в положительном диапазоне). Это означает, что в нашем отрицательном диапазоне мы хотим сдвинуть наш желтый (50-й процентиль) от -2 до числа около -8.5, чтобы он соответствовал положительному диапазону. Я написал функцию под названием
Function iGetPercentileFromNumber(my_range As Range, num_to_find As Double) это делает именно это! Более конкретно он принимает и считывает значения в матрица. Затем он добавляет num_to_find к массиву и выясняет, какой процентиль num_to_find принадлежит как яnteger 0-100 (отсюда я в имя функции). Опять же, используя наши данные примера, мы бы назвали что-то вроде
imidcolorpercentile = iGetPercentileFromNumber(negrange with extra element -13, -8.5)
где -8.5-отрицательное (50-е процентильное число положительного диапазона = 8.5). Не волнуйтесь, код автоматически предоставляет диапазоны и цифры, это только для вашего понимания. Функция добавила бы -8.5 к нашему массив отрицательных значений {-13,-1,-1,-2,-2,-2,-2,-3,-4,-8.5} тогда выясните, какой это процентиль.
теперь мы берем этот процентиль и передаем его в качестве средней точки для нашего условного форматирования negrange. поэтому мы изменили желтый цвет с 50-го процентиля
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
к нашему новому значению
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = imidcolorpercentile 'was 50
что теперь выравнивается цвет!! мы в основном создали симметричную по внешнему виду цветовую полосу. Даже если наши числа далеки от симметрии.
хорошо, я знаю, что это была тонна, чтобы читать и переваривать. но вот основные takeaways этот код - использует полное 3-цветное Условное форматирование (а не просто устанавливает два крайних цвета одинаково, чтобы выглядеть как значение abs) - создает симметричные цветовые диапазоны с помощью заблокированной ячейки (скажем, под кнопкой) для удержания экстремальных значений - использует статистический анализ, чтобы соответствовать цветовым градиентам даже в искаженных наборах данных
оба шага необходимы, и ни один из них сам по себе не является достаточным чтобы создать истинную зеркальную цветовую шкалу
поскольку это решение требует статистического анализа набора данных, вам нужно будет запустить его снова в любое время, когда вы изменили номер (что на самом деле было раньше, я просто никогда не говорил об этом)
а теперь код. Поместите его в 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