VBA100本ノック 92本目：セルの色を16進で返す関数
セルの色（塗りつぶし色orフォント色）を16進表示で戻すユーザー定義関数を作成する問題です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。
出題
セルの色を16進（赤="#FF0000"、青="#0000FF"）で戻すユーザー定義関数を作成します。
=関数(セル範囲,対象)
対象： 1=塗りつぶし、2=フォント色
セル範囲の大きさにあわせて戻り値を配列で戻す。
つまり配列数式またはスピルに対応してください。
※"#RGB"です。順番に注意。
VBA作成タイム
この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。
他の人の回答および解説を見て、書いたVBAを見直してみましょう。
頂いた回答
解説
RGBはそれぞれ1バイトですが、順番が逆になります。
数値のビットではBGRの順になるので気を付けてください。
256で割りながら求めても良いですが、HEX関数の結果を入れ替えるのが簡単だと思います。
Function VBA100_92_01(セル範囲, 区分)
If セル範囲.Areas.Count > 1 Then Exit Function
If Not (区分 = 1 Or 区分 = 2) Then Exit Function
Dim rtnAry
ReDim rtnAry(1 To セル範囲.Rows.Count, 1 To セル範囲.Columns.Count)
Dim i As Long, j As Long, sHex As String
For i = 1 To セル範囲.Rows.Count
For j = 1 To セル範囲.Columns.Count
Select Case 区分
Case 1: sHex = DecToHex(セル範囲.Cells(i, j).Interior.Color, 6)
Case 2: sHex = DecToHex(セル範囲.Cells(i, j).Font.Color, 6)
End Select
rtnAry(i, j) = "#" & Mid(sHex, 5, 2) & Mid(sHex, 3, 2) & Mid(sHex, 1, 2)
Next
Next
VBA100_92_01 = rtnAry
End Function
Function DecToHex(ByVal aDec As Long, ByVal aNum As Long) As String
DecToHex = Right(String(aNum, "0") & Hex(aDec), aNum)
End Function
Type（ユーザー定義型）+LSetを使った本来は推奨されない方法でRGBを分割することもできます。
これについては記事補足に掲載しました。
補足
このバイト分割にType+LSetを使っています。
Type tColorRGB
R As Byte
G As Byte
B As Byte
S As Byte
End Type
Type tColorNum
N As Long
End Type
Function VBA100_92_02(セル範囲, 区分)
If セル範囲.Areas.Count > 1 Then Exit Function
If Not (区分 = 1 Or 区分 = 2) Then Exit Function
Dim rtnAry
ReDim rtnAry(1 To セル範囲.Rows.Count, 1 To セル範囲.Columns.Count)
Dim i As Long, j As Long
For i = 1 To セル範囲.Rows.Count
For j = 1 To セル範囲.Columns.Count
Select Case 区分
Case 1: rtnAry(i, j) = getRGB(セル範囲.Cells(i, j).Interior.Color)
Case 2: rtnAry(i, j) = getRGB(セル範囲.Cells(i, j).Font.Color)
End Select
Next
Next
VBA100_92_02 = rtnAry
End Function
Function getRGB(ByVal aNum As Long) As String
Dim cNum As tColorNum: cNum.N = aNum
Dim cRGB As tColorRGB: LSet cRGB = cNum
getRGB = "#" & DecToHex(cRGB.R, 2) & DecToHex(cRGB.G, 2) & DecToHex(cRGB.B, 2)
End Function
Function DecToHex(ByVal aDec As Long, ByVal aNum As Long) As String
DecToHex = Right(String(aNum, "0") & Hex(aDec), aNum)
End Function
わざわざType+LSetをつかうような処理でもないのですが、数値とRGBについて理解する一助になるかもしれないと思って、このようなVBAを書いてみました。
そもそも、この方法自体をMSが推奨していませんので、この点は誤解なきようお願いいたします。
サイト内関連ページ
同じテーマ「VBA100本ノック」の記事
89本目：2つのフォルダの統合
90本目：セルに重なっている画像の削除
91本目：時間計算（残業時間の月間合計）
92本目：セルの色を16進で返す関数
93本目：複数ブックを連結して再分割
94本目：表範囲からHTMLのtableタグを作成
95本目：図形のテキストを検索するフォーム作成
96本目：Accessデータを取得（マスタ結合&抽出）
97本目：Accessデータを取得（グループ集計）
98本目：席替えルールが守られているか確認
99本目：自動席替え（行列と前後左右が全て違うように）
新着記事NEW ・・・新着記事一覧を見る
抜けている数値を探せ｜エクセル雑感(2022-07-01)
.Net FrameworkのSystem.Collectionsを利用｜VBA技術解説(2022-06-29)
迷路ネコが影分身の術を体得したら…｜エクセル雑感(2022-06-27)
迷路にネコが挑戦したら、どうなるかな…｜エクセル雑感(2022-06-26)
サロゲートペアに対応した自作関数（Len,Left,Mid,Right）｜エクセル雑感(2022-06-24)
「マクロの登録」で登録できないプロシージャーは?｜エクセル雑感(2022-06-23)
オブジェクトのByRef、ByVal、Variant｜エクセル雑感(2022-06-22)
コメントから特定形式の年月を取り出す｜エクセル雑感(2022-06-19)
4,9を使わない連番作成｜エクセル雑感(2022-06-17)
連番を折り返して出力｜エクセル雑感(2022-06-16)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.RangeとCellsの使い方｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.繰り返し処理（For Next)｜VBA入門
5.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
6.Excelショートカットキー一覧｜Excelリファレンス
7.マクロって何？VBAって何？｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門
10.エクセルVBAでのシート指定方法｜VBA技術解説
- ホーム
- マクロVBA入門編
- VBA100本ノック
- 92本目：セルの色を16進で返す関数
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。