Итак, это первый раз, когда я отправляю код, так что здесь. Я думал, что макро-маршрут будет подходить, но так как вы не можете установить шрифт таким же, как цвет ячейки, используя условное форматирование, тогда единственный другой способ - это изменить оба с помощью макроса, который работает аналогично Эффект условного формата см. ниже:
Sub change()
Dim Rstart, Rmid, Rend, Gstart, Gmid, Gend, Bstart, Bmid, Bend, Rsd, Rdd,_
Gsd, Gdd, Bsd, Bdd, Rcell, Gcell, Bcell As Integer
Dim maxsel, minsel, halfsel, halfval, v As Double
Rstart = 0
Rmid = 230
Rend = 255
Gstart = 0
Gmid = 230
Gend = 0
Bstart = 255
Bmid = 230
Bend = 0
Rsd = Rmid - Rstart
Rdd = Rend - Rmid
Gsd = Gmid - Gstart
Gdd = Gend - Gmid
Bsd = Bmid - Bstart
Bdd = Bend - Bmid
maxsel = Application.WorksheetFunction.Max(Selection)
minsel = Application.WorksheetFunction.Min(Selection)
halfsel = (maxsel - minsel) / 2
halfval = minsel + halfsel
If halfval = 0 Then Exit Sub
Dim cell As Variant
For Each cell In Selection
v = cell.Value
If v >= minsel And v < halfsel Then
Rcell = Round((Rstart + ((halfval - v) / halfsel) * Rsd), 0)
Gcell = Round((Gstart + ((halfval - v) / halfsel) * Gsd), 0)
Bcell = Round((Bstart + ((halfval - v) / halfsel) * Bsd), 0)
Else
Rcell = Round((Rmid + ((v - halfval) / halfsel) * Rdd), 0)
Gcell = Round((Gmid + ((v - halfval) / halfsel) * Gdd), 0)
Bcell = Round((Bmid + ((v - halfval) / halfsel) * Bdd), 0)
End If
cell.Font.Color = RGB(Rcell, Gcell, Bcell)
cell.Interior.Color = RGB(Rcell, Gcell, Bcell)
Next cell
End Sub
Надеюсь, это кому-нибудь поможет, хотя уже три года слишком поздно для первоначального вопроса.