Excel formula that prints cell color (ColorIndex or RGB)

后端 未结 3 835
没有蜡笔的小新
没有蜡笔的小新 2020-12-18 12:30

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)
相关标签:
3条回答
  • 2020-12-18 12:47

    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

    0 讨论(0)
  • 2020-12-18 12:55

    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
    
    0 讨论(0)
  • 2020-12-18 13:08

    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
    
    0 讨论(0)
提交回复
热议问题