VBA練習問題
VBA100本ノック 92本目:セルの色を16進で返す関数

VBAを100本の練習問題で鍛えます
最終更新日:2021-02-21

VBA100本ノック 92本目:セルの色を16進で返す関数


セルの色(塗りつぶし色orフォント色)を16進表示で戻すユーザー定義関数を作成する問題です。


ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータはご自身でご用意ください。


出題

出題ツイートへのリンク

#VBA100本ノック 92本目
セルの色を16進(赤="#FF0000"、青="#0000FF")で戻すユーザー定義関数を作成します。
=関数(セル範囲,対象)
対象: 1=塗りつぶし、2=フォント色
セル範囲の大きさにあわせて戻り値を配列で戻す。
つまり配列数式またはスピルに対応してください。
※"#RGB"です。順番に注意。

マクロ VBA 100本ノック


マクロ VBA 100本ノック


VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。


他の人の回答および解説を見て、書いたVBAを見直してみましょう。


頂いた回答

解説

引数のセル範囲と同じ大きさの配列を用意して、そこにRGBの16進表示文字列をいれて戻せば良いです。
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を分割することもできます。
これについては記事補足に掲載しました。


補足

RGBについては、以下でも詳しく解説しています。
マクロ記録での色のマイナス数値について
ツイッターで出したVBAのお題です。マクロの記録で文字色などの色を指定するとマイナス数値で記録される場合がありますが、このマイナス数値は何かを問う問題です。お題のツイート https://twitter.com/yamaoka_ss/status/1272119270026051587 【エクセル問題】 マクロの記…

色の数値をLong型の変数に入れて、1バイトずつに分割すればRGBを取り出せます。
このバイト分割にType+LSetを使っています。
LSetとユーザー定義型のコピー(100桁の足し算)
数の単位に「無量大数」というものがあります。その桁数は10^68(10^88とする場合もあるよう)です。VBAでこの無量大数の足し算をするにはどうしたら良いでしょうか。方法としては、VBAで計算できる桁数にちぎって足し上げていけば良いでしょう。


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が推奨していませんので、この点は誤解なきようお願いいたします。


サイト内関連ページ

第33回.セルの書式(フォント,Font)
セルで表示している文字の書体をマクロVBAで指定する方法です。セル(Rangeオブジェクト)のフォントは、Fontプロパティになります。Fontプロパティは、Fontオブシェクトを返します。解りづらい説明だと思います。
第34回.セルの書式(塗りつぶし,Interior)
セルを目立たせる最も有効な手段は、セルを色で塗りつぶすことでしょう、セルを塗りつぶす時のマクロVBAの解説です。セル(Rangeオブジェクト)の塗りつぶし(パターン)は、Interiorプロパティになります。Interiorプロパティは、Interiorオブシェクトを返します。




同じテーマ「VBA100本ノック」の記事

89本目:2つのフォルダの統合
90本目:セルに重なっている画像の削除
91本目:時間計算(残業時間の月間合計)
92本目:セルの色を16進で返す関数
93本目:複数ブックを連結して再分割
94本目:表範囲からHTMLのtableタグを作成
95本目:図形のテキストを検索するフォーム作成
96本目:Accessデータを取得(マスタ結合&抽出)
97本目:Accessデータを取得(グループ集計)
98本目:席替えルールが守られているか確認
99本目:自動席替え(行列と前後左右が全て違うように)


新着記事NEW ・・・新着記事一覧を見る

キーボード操作だけで非表示列を表示|エクセル雑感(2021-05-11)
変数を考えることはロジックを考える事|エクセル雑感(2021-04-11)
RangeオブジェクトのFor EachとAreasについて|VBA技術解説(2021-04-08)
PropertyのSetはLetでも良い|VBA技術解説(2021-03-31)
エクセル麻雀ミニゲーム|VBAサンプル集(2021-03-09)
VBA100本ノック 100本目:WEBから100本ノックのリストを取得|VBA練習問題(2021-03-03)
VBA100本ノック 魔球編:2桁の最小公倍数|VBA練習問題(2021-02-02)
Select Caseでの短絡評価(ショートサーキット)の使い方|VBA技術解説(2021-01-03)
VBA100本ノック 迷宮編:巡回セル問題|VBA練習問題(2020-12-31)
VBA100本ノック 魔球編:閉領域の塗り潰し|VBA練習問題(2020-12-16)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.Excelショートカットキー一覧|Excelリファレンス
3.RangeとCellsの使い方|VBA入門
4.マクロって何?VBAって何?|VBA入門
5.変数宣言のDimとデータ型|VBA入門
6.繰り返し処理(For Next)|VBA入門
7.ひらがな⇔カタカナの変換|エクセル基本操作
8.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
9.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
10.セルに文字を入れるとは(Range,Value)|VBA入門




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ