根据单元格中的HEX值设置自动颜色背景？

Question

我已经想到了一个方法，可以通过手动添加单元格的条件格式规则来实现：但是，我希望当我在单元格中输入HEX值时，所有16,000,000个HEX值颜色都能自动出现，所以"手动"添加这些HEX值听起来有点困难！是否有一种方法可以让所有16,000,000种颜色自动加入并根据单元格中的HEX值应用背景颜色？ 换句话说，当我在单元格中输入0000ff时，我正在尝试获得蓝色背景，然后当单元格的HEX值更改时，背景会更改为相应的颜色=>当输入ff0000时，BGC更改为红色，然后是绿色，白色，ffff...等16,000,000种以上的颜色。

- romain

---

=sparkline(1,{"charttype","bar";"color1",A1}) 将上述程序相关内容翻译成中文。仅返回翻译后的文本。 - Birju Shah

Answer 1

一个Worksheet_Change事件宏，可以方便地将十六进制转换为RGB。工作表的HEX2DEC函数应该能够处理这个转换。

右键单击工作表的名称选项卡，选择查看代码。当VBE打开时，将以下内容粘贴到代码工作表中，标题类似于Book1-Sheet1（代码）。

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo bm_Safe_Exit
    Application.EnableEvents = False
    Dim rng As Range, clr As String
    For Each rng In Target
        If Len(rng.Value2) = 6 Then
            clr = rng.Value2
            rng.Interior.Color = _
              RGB(Application.Hex2Dec(Left(clr, 2)), _
                  Application.Hex2Dec(Mid(clr, 3, 2)), _
                  Application.Hex2Dec(Right(clr, 2)))
        End If
    Next rng

bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

按下 Alt+Q 键返回到工作表。在单元格中键入任何 6 个字符的十六进制代码以提供背景色。

        

- user4039065

---

您的代码虽然较长，但似乎能够得到预期的结果。我无法解释为什么我的代码会将红色和蓝色颠倒，即使我尝试使用Target.Text而不是Target.Value！ - A.S.H

谢谢，我非常感激。 - romain

非常感谢，这在Excel上完美运行。是否有可能将其复制到Google Excel表格上，并添加到条件格式规则的功能中呢？ - romain

@romain - 虽然我不是Google表格事件“触发器”的专家，但条件格式与Excel的工作方式基本相同。简而言之，结果颜色的更改不能是动态的；它必须事先设置并保持静态。这意味着您需要为每个要能够再现的颜色设置一个CF规则，而可能性的数量使该方法不切实际。 - user4039065

您IP地址为143.198.54.68，由于运营成本限制，当前对于免费用户的使用频率限制为每个IP每72小时10次对话，如需解除限制，请点击左下角设置图标按钮（手机用户先点击左上角菜单按钮）。 - romain

Answer 2

在我看来，第一个答案非常好。我对VBA不是很熟悉:) 但是为了避免某些问题，最好以#开头的十六进制数，并检查第一个符号是否为#，因为我们需要控制一个范围。然后控制值的完整长度等于7个符号，然后计算颜色以设置背景。

干杯！

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo bm_Safe_Exit
    Application.EnableEvents = False
    Dim rng As Range, clr As String
    For Each rng In Target
        If Left(rng.Value2, 1) = "#" And Len(rng.Value2) = 7 Then
            clr = Right(rng.Value2, 6)
            rng.Interior.Color = _
              RGB(Application.Hex2Dec(Left(clr, 2)), _
                  Application.Hex2Dec(Mid(clr, 3, 2)), _
                  Application.Hex2Dec(Right(clr, 2)))
        End If
    Next rng

bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

- Alexey Ryzhkov

Answer 3

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.count <> 1 Then Exit Sub
    Target.Interior.Color = CLng("&H" & Target.Value)
End Sub

它可以工作，但出于某种原因基于BGR而不是RGB：ff0000会变成蓝色，而0000ff会变成红色:D

- A.S.H

---

十六进制转十进制的快捷方式真不错。我就是想不起来这个快速方法。 - user4039065

@Jeeped 哈哈，不过请看回答末尾的注释。它让我感到惊讶 :p - A.S.H

非常感谢，我会尝试的。 - romain

我有另一个问题：它如何在Google电子表格（Excel）上使用？我想将桌面上的Excel文档与Google电子表格中的文档合并...但是代码在Google电子表格上不再起作用:( - romain

Answer 4

稍微更新Alexey Ryzhkov的提交。在单元格清空时添加将背景重置为“无”的功能。

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo bm_Safe_Exit
    Application.EnableEvents = False
    Dim rng As Range, clr As String
    For Each rng In Target
        If IsEmpty(rng.Value2) Then
            rng.Interior.Color = xlNone
        ElseIf Trim(rng.Value2) = "" Then
            rng.Interior.Color = xlNone
        ElseIf Left(rng.Value2, 1) = "#" And Len(rng.Value2) = 7 Then
            clr = Right(rng.Value2, 6)
            rng.Interior.Color = RGB(Application.Hex2Dec(Left(clr, 2)), Application.Hex2Dec(Mid(clr, 3, 2)), Application.Hex2Dec(Right(clr, 2)))
        End If
    Next rng

bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

- skywalker