How to highlight a cell using the hex color value within the cell?

前端 未结 6 679
清歌不尽
清歌不尽 2020-11-30 04:02

I have a spreadsheet of symbols and matching hex colors. I want to fill the cell itself (or the one next to it) with the hex color within the cell. I\'ve read a bit about \"

相关标签:
6条回答
  • 2020-11-30 04:42

    Minor edit to Jon Peltier's answer. His function ALMOST works, but the colors it renders are incorrect due to the fact the Excel will render as BGR rather than RGB. Here is the corrected function, which swaps the pairs of Hex values into the 'correct' order:

    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
    
    0 讨论(0)
  • 2020-11-30 04:42

    This is another option - it updates the cell color when you select the cell assuming the value in the cell starts with "#" and is 7 characters.

    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
    
    0 讨论(0)
  • 2020-11-30 04:55

    Much simpler:

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

    Mid strips off the leading "#", Hex2Dec turns the hex number into a decimal value that VBA can use.

    So select the range to process, and run this:

    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
    
    0 讨论(0)
  • 2020-11-30 04:55

    There is no need to repeatedly pierce the VBA/Worksheet barrier to convert. This streamlined version gets the byte order correct:

    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
    
    0 讨论(0)
  • 2020-11-30 05:01

    Can't be achieved with Conditional Formatting for all colours.

    Assuming: Row1 contains Data Labels, data set does not have gaps, the HEX colour is for the fill not the font, you have parsed the HEX colour values (numbers, not formulae) into Columns C:E (R,G,B) and that you do not require to do this often, then the ColourCells macro might suit:

    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
    

    and enter the value you want for n when prompted.

    Sample output and formulae etc:

    SO11466034

    Excel's RGB() function actually creates a BGR value (I don't think anybody that might know why is saying why though) so Excel shows nibbles in reverse order. For the code Columns3,4,5 was logical but BGR rather than the conventional RGB in the image I thought might look odd. For F in the image the C3 value (the LEFT hand column of the 'RGB' three) is derived from applying RIGHT() to the Hex colour.

    0 讨论(0)
  • 2020-11-30 05:03

    For this, a userform can be made with the Hex2Dec function.

    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) & ")"
    

    For example ;the entered value to textbox: #FF8800 - Result : RGB(255,136,0)

    0 讨论(0)
提交回复
热议问题