如何使用单元格中的十六进制颜色值突出显示单元格?

kno*_*ody 17 excel vba conditional-formatting excel-vba excel-2010

我有一个符号和匹配的十六进制颜色的电子表格.我想用单元格内的十六进制颜色填充单元格本身(或旁边的单元格).我已经阅读了一些关于"条件格式化"的内容,我认为这是做到这一点的方法.

我怎么能达到我想要的结果?

pnu*_*uts 67

对于所有颜色,无法使用条件格式实现.

假设:Row1包含数据标签,数据集没有间隙,HEX颜色用于填充而不是字体,您已将HEX颜色值(数字,而不是公式)解析为列C:E(R,G,B)并且您不需要经常这样做,那么ColourCells宏可能适合:

Sub ColourCells()
Dim HowMany As Integer
On Error Resume Next
Application.DisplayAlerts = False
HowMany = Application.InputBox _
(Prompt:="Enter last row number.", Title:="To apply to how many rows?", Type:=1)
On Error GoTo 0
Application.DisplayAlerts = True
If HowMany = 0 Then
Exit Sub
Else
   Dim i As Integer
   For i = 2 To HowMany
      Cells(i, 3).Interior.Color = RGB(Cells(i, 3), Cells(i, 4), Cells(i, 5))
   Next i
End If
End Sub
Run Code Online (Sandbox Code Playgroud)

并在提示时输入您想要的值n.

样本输出和公式等:

SO11466034

Excel的RGB()函数实际上创建了一个BGR值(我不认为任何人可能知道为什么会说出原因)所以Excel以相反的顺序显示半字节.对于代码Columns3,4,5是合乎逻辑的但是BGR而不是我认为可能看起来奇怪的图像中的传统RGB.对于图像中的F,C3值('RGB'三的LEFT指针列)是通过将RIGHT()应用于十六进制颜色而得到的.


use*_*932 20

对Jon Peltier的回答进行了少量编辑.他的函数ALMOST有效,但它渲染的颜色不正确,因为Excel会渲染为BGR而不是RGB.以下是更正后的函数,它将十六进制值对交换为"正确"顺序:

Sub ColorCellsByHex()
  Dim rSelection As Range, rCell As Range, tHex As String

  If TypeName(Selection) = "Range" Then
  Set rSelection = Selection
    For Each rCell In rSelection
      tHex = Mid(rCell.Text, 6, 2) & Mid(rCell.Text, 4, 2) & Mid(rCell.Text, 2, 2)
      rCell.Interior.Color = WorksheetFunction.Hex2Dec(tHex)
    Next
  End If
End Sub
Run Code Online (Sandbox Code Playgroud)

  • 如果您还希望隐藏颜色代码,则在“ Next”之前添加以下行:rCell.Font.Color = WorksheetFunction.Hex2Dec(tHex) (2认同)

Jon*_*ier 5

更简单:

ActiveCell.Interior.Color = WorksheetFunction.Hex2Dec(Mid$(ActiveCell.Text, 2))
Run Code Online (Sandbox Code Playgroud)

中间剥离前导"#",Hex2Dec将十六进制数转换为VBA可以使用的十进制值.

因此,选择要处理的范围,然后运行:

Sub ColorCellsByHexInCells()
  Dim rSelection As Range, rCell As Range

  If TypeName(Selection) = "Range" Then
  Set rSelection = Selection
    For Each rCell In rSelection
      rCell.Interior.Color = WorksheetFunction.Hex2Dec(Mid$(rCell.Text, 2))
    Next
  End If
End Sub
Run Code Online (Sandbox Code Playgroud)