vba - 如何使用单元格内的十六进制颜色值突出显示单元格？

Question

我有一个符号电子表格和匹配的十六进制颜色。我想用单元格内的十六进制颜色填充单元格本身（或旁边的那个）。我读过一些关于“条件格式”的文章，我认为这就是这样做的方法。

我怎样才能达到我想要的结果？

Answer 1

无法使用所有颜色的条件格式来实现。

假设：第 1 行包含数据标签，数据集没有间隙，十六进制颜色用于填充而不是字体，您已将十六进制颜色值（数字，而不是公式）解析为列 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

并在出现提示时输入所需的 n 值。

示例输出和公式等：

Excel 的 RGB() 函数实际上创建了一个 BGR 值（我认为没有人可能知道为什么会说为什么），因此 Excel 以相反的顺序显示半字节。对于代码 Columns3,4,5 是合乎逻辑的，但 BGR 而不是图像中的传统 RGB，我认为可能看起来很奇怪。对于图像中的 F，C3 值（“RGB”三的左手列）是通过将RIGHT()应用于十六进制颜色而得出的。

Answer 2

对 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

Answer 3

简单得多：

ActiveCell.Interior.Color = WorksheetFunction.Hex2Dec(Mid$(ActiveCell.Text, 2))

Mid 去掉前导的“#”，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

Answer 4

这是另一个选项 - 当您选择单元格时它会更新单元格颜色，假设单元格中的值以“#”开头并且是 7 个字符。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If (Left(ActiveCell.Text, 1) = "#" And Len(ActiveCell.Text) = 7) Then
    ActiveCell.Interior.Color = WorksheetFunction.Hex2Dec(Mid$(ActiveCell.Text, 2))
End If

End Sub

Answer 5

无需反复突破 VBA/工作表障碍即可进行转换。这个简化的版本得到正确的字节顺序：

Sub ColorCellsByHex()
    Dim r
    If TypeName(Selection) <> "Range" Then Exit Sub
    For Each r In Selection
        r.Interior.Color = Abs(("&H" & Mid(r, 6, 2) & Mid(r, 4, 2) & Mid(r, 2, 2)))
    Next
End Sub

Answer 6

为此，可以使用 Hex2Dec 函数制作用户表单。

Function Hex2Dec(n1 As String) As Long
    Dim nl1 As Long
    Dim nGVal As Long
    Dim nSteper As Long
    Dim nCount As Long
    Dim x As Long
    Dim nVal As Long
    Dim Stepit As Long
    Dim hVal As String

    nl1 = Len(n1)
    nGVal = 0
    nSteper = 16
    nCount = 1
    For x = nl1 To 1 Step -1
       hVal = UCase(Mid$(n1, x, 1))
       Select Case hVal
         Case "A"
           nVal = 10
         Case "B"
           nVal = 11
         Case "C"
           nVal = 12
         Case "D"
           nVal = 13
         Case "E"
           nVal = 14
         Case "F"
           nVal = 15
         Case Else
           nVal = Val(hVal)
       End Select
       Stepit = (nSteper ^ (nCount - 1))
       nGVal = nGVal + nVal * Stepit
       nCount = nCount + 1
    Next x
    Hex2Dec = nGVal
End Function
...
UserForm1.TextBox1 = "RGB(" & Hex2Dec(UserForm1.txtHex1.Value) & "," & _
           Hex2Dec(UserForm1.txtHex2.Value) & "," & Hex2Dec(UserForm1.txtHex3.Value) & ")"

例如；输入到文本框的值：#FF8800 - 结果：RGB(255,136,0)