3

在 Excel 中是否有检索单元格的 ColorIndex（或 RGB）的公式？

我找到了以下功能：

CELL(info_type, the_cell)

记录在这里，但它没有任何单元格颜色的参考信息。

这是一个color信息，但对我来说没用。其实是这样描述的：

"color"如果单元格的颜色格式为负值，则值为 1；否则返回 0（零）。

任何的想法？

此外，我发现执行此操作的 VBA 属性是Cell.Interior.Color但实际上我没有使用宏，而是使用简单的 Excel 公式。有没有办法用公式模拟 VBA 函数？

4

3 回答 3

4

这里有一些小功能供您使用。从您的工作表中，按Alt-F11进入 VBA 编辑器，插入一个新模块，粘贴以下代码，返回您的工作表并按名称使用它们，例如=FillColor(A1)

前两个是承诺的“3-liners”，为字体和背景颜色提供十进制值 - 虽然不是很有用

第二对将十进制数转换为RGB，返回格式为N,N,N的字符串

第三对是数组公式- 连续选择 3 个单元格，输入公式并按Ctrl+ Shift+Enter以获得 3 个相邻单元格中的数字 RGB 值

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

请注意：更改单元格的颜色不会通过上述函数/公式开始重新计算，因为通常不应该重新着色单元格来驱动重新计算。您必须使用Ctrl+ Alt+ Shift+手动启动完全重新计算F9

于 2013-01-11T17:09:01.887 回答
0

以下函数将显示选定单元格的 RGB 值。

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
于 2014-10-24T02:13:21.317 回答
0

请尝试以下

所做的更改：查看代码中的注释

模块

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

工作表

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
于 2016-04-21T04:22:33.013 回答