シンボルと一致する16進数の色のスプレッドシートがあります。セル自体(またはその隣のセル)をセル内の16進数の色で塗りつぶします。私は「条件付き書式」について少し読んだことがあり、それがその方法だと思います。
希望する結果をどのように達成できますか?
すべての色の条件付きフォーマットでは達成できません。
仮定:Row1にデータラベルが含まれ、データセットにギャップがなく、16進数の色はフォントではなく塗りつぶし用であり、16進数の色値(数式ではなく数値)を列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は論理的でしたが、画像内の従来のRGBではなくBGRが奇妙に見えると思いました。画像のFの場合、C3値([〜#〜] left [〜#〜] 'RGB' 3の手の列)は、RIGHT()の適用から得られます= 16進数の色に。
Jon Peltierの回答を少し編集しました。彼の関数ALMOSTは機能しますが、ExcelがRGBではなくBGRとしてレンダリングするため、レンダリングされる色は正しくありません。これが修正された関数で、16進値のペアを「正しい」順序に入れ替えます。
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
はるかに簡単:
ActiveCell.Interior.Color = WorksheetFunction.Hex2Dec(Mid$(ActiveCell.Text, 2))
Midは先頭の "#"を取り除き、Hex2Decは16進数をVBAが使用できる10進数値に変換します。
処理する範囲を選択して、これを実行します。
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
これは別のオプションです-セルの値が「#」で始まり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
このため、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)