Excel formula that prints cell color (ColorIndex o

问题:

Is there, in Excel, a Formula that retrieve the ColorIndex (or RGB) of a cell?

I found the follwing function:

CELL(info_type, the_cell)

documented here, but it does not have any reference information for cell color.

The is a color info, but it's useless for me. In fact, it is described as follows:

"color" The value 1 if the cell is formatted in color for negative values; otherwise returns 0 (zero).

Any idea?

Also, I turned out that the VBA property that do this is Cell.Interior.Color but actually I'm not using Macros, but simple Excel formulas. Is there maybe a way to emulate VBA functions with a formula?

回答1:

Here are some small functions for you. From your sheet, press Alt-F11 to reach the VBA editor, insert a new module, paste the below code, go back to your worksheet and use them by their names, like in =FillColor(A1)

The first two are the promised "3-liners" giving decimal values for font and background colors - not very useful though

The second pair converts the decimal number to RGB and returns a string of format N, N, N

The third pair are array formulas - select 3 cells in a row, enter the formula and press Ctrl+Shift+Enter to obtain numeric RGB values in 3 neighboring cells

Function FillColor(Target As Range) As Variant
    FillColor = Target.Interior.Color
End Function

Function FontColor(Target As Range) As Variant
    FontColor = Target.Font.Color
End Function

Function FillColorRGB(Target As Range) As Variant
Dim N As Double

    N = Target.Interior.Color
    FillColorRGB = Str(N Mod 256) & ", " & Str(Int(N / 256) Mod 256) & ", " & Str(Int(N / 256 / 256) Mod 256)
End Function

Function FontColorRGB(Target As Range) As Variant
Dim N As Double

    N = Target.Font.Color
    FontColorRGB = Str(N Mod 256) & ", " & Str(Int(N / 256) Mod 256) & ", " & Str(Int(N / 256 / 256) Mod 256)
End Function

Function FillColorRGBArray(Target As Range) As Variant
Dim N As Double, A(3) As Integer

    N = Target.Interior.Color
    A(0) = N Mod 256
    A(1) = Int(N / 256) Mod 256
    A(2) = Int(N / 256 / 256) Mod 256
    FillColorRGBArray = A
End Function

Function FontColorRGBArray(Target As Range) As Variant
Dim N As Double, A(3) As Integer

    N = Target.Font.Color
    A(0) = N Mod 256
    A(1) = Int(N / 256) Mod 256
    A(2) = Int(N / 256 / 256) Mod 256
    FontColorRGBArray = A
End Function

A word of caution: changing the color of a cell does not start recalculation by the above functions/formulas, as recoloring a cell in general is not supposed to drive recalculation. You have to manually start a full recalculation using Ctrl+Alt+Shift+F9

回答2:

The following function will display the RGB value of a selected cell.

Function CellColorValue(CellLocation As Range)
    Dim sColor As String

    Application.Volatile
    'Retrieve hex value into string sColor    
    sColor = Right("000000" & Hex(CellLocation.Interior.Color), 6)
    'Return the string Version e.g. 255,255,255 RGB color value found in 
    'Excel cell. Use in built worksheet function to convert Hex to Decimal
    'Use string function to separate Hex string into three parts
    CellColorValue = Application.WorksheetFunction.Hex2Dec(Right(sColor, 2)) & "," & application.WorksheetFunction.Hex2Dec(Mid(sColor, 3, 2)) & "," & Application.WorksheetFunction.Hex2Dec(Left(sColor, 2))
End Function

回答3:

please try with below

Changes made : see the comment in code

Module

Public Function Performance_Message(NonPreferredAvg As Single _
                                  , NonPreferredAvgname As String _
                                  , PreferredAvg As Single _
                                  , PreferredAvgname As String _
                                  , Optional Outputtype As String _
                                   ) As Variant

    Dim performancemessage As String
    Dim averagedifference As Single
    Dim stravgdif As String
    Dim cellcolor As String

    averagedifference = Abs(NonPreferredAvg - PreferredAvg)
    stravgdif = FormatPercent(averagedifference, 2)

    Select Case PreferredAvg
        Case Is < NonPreferredAvg
            performancemessage = PreferredAvgname & " Is " & stravgdif & " Less Than " & NonPreferredAvgname
            cellcolor = 4 '"green" 'Changes made

        Case Is = NonPreferredAvg
            performancemessage = PreferredAvgname & " Equals " & NonPreferredAvgname
            cellcolor = 6 '"yellow" ''Changes made

        Case Is > NonPreferredAvg
            performancemessage = PreferredAvgname & " Is " & stravgdif & " Greater Than " & NonPreferredAvgname
            cellcolor = 5 '"blue" 'Changes made
        Case Else
            performancemessage = "Something Bad Happened"
    End Select
    If Outputtype = "color" Then
        Performance_Message = cellcolor
    Else
        Performance_Message = performancemessage
    End If
End Function

Worksheet

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim myColor As Double
  myColor = Target.Value ''Changes made
  Call SetPerformancecolor(Target, myColor)
End Sub

Private Sub SetPerformancecolor(Target As Range, myColor As Double)
  Target.Interior.ColorIndex = myColor ''Changes made
End Sub