数式の参照先ごとにフォント色分けを一括設定

Excel資料の見た目について「外資系金融のExcel作成術」という本で学んだ内容を何点か実践している。

外資系金融のExcel作成術: 表の見せ方&財務モデルの組み方

作者:慎泰俊
発売日: 2014/04/04
メディア: 単行本

そのうちの１つにフォントの色について記載があり自分用の資料には取り入れている。
※見た目というか「モデル」という表の作成ルールの１つです。

インプット(数値入力欄)は青
数式 (同一シート内)は黒
リンク(別シート参照数式)は緑

この色分けを先日作成したアドオン機能を利用すれば自動で出来るのではと思いチャレンジしてみた。

www.excellovers.com

完成品動作
色分け
コード
まとめ

完成品動作

f:id:ExcelLover:20210511222727g:plain

選択範囲内のセルに対して上記の色分けを行う。

色分け

3色の色分けは以下の方法で行った。

インプット(数値入力欄)の青

ジャンプ機能に相当するSpecialcellsを使用した。
ジャンプ機能では下記のように「定数」と「数値」にチェックを入れることで、
数値を直接入力しているセルのみを選択することが出来る。

VBAのコードでは下記のようになる。

Rangeオブジェクト.SpecialCells(xlCellTypeConstants, 1)

数式 (同一シート内)の黒

こちらも同様にSpecialcellsを利用して数式を選択している。
Specialcellsの引数をxlCellTypeFormulasに変更している。

Rangeオブジェクト.SpecialCells(xlCellTypeFormulas)

黒色の場合は処理を何もしないことで黒のままになる、としている。
該当フォントカラーが黒以外の可能性もあるが今回は考慮しないことにした。

リンク(別シート参照式)の緑

黒と同じようにSpecialCells(xlCellTypeFormulas)で数式セルを選択している。

数式セルが別シートを参照していればフォントカラーを緑にしている。

別シートを参照しているかどうかは冒頭で紹介した過去記事に記載している、
NavigateArrowを利用している。

コード

Sub ModelColorSetting(ByVal control As IRibbonControl)
     Dim vv検索対象セル As Range: Set vv検索対象セル = Selection
     If vv検索対象セル.Count = 1 Then MsgBox "2つ以上のセルを選択してください", vbInformation + vbOKOnly: Exit Sub
     If vv検索対象セル.Parent.ProtectContents Then Exit Sub
On Error Resume Next
     vv検索対象セル.SpecialCells(xlCellTypeConstants, 1).Font.Color = vbBlue
     
     Dim myRng As Range
     Dim vv検索結果セル As Range
     Dim vvリンクセル As Range
     For Each myRng In vv検索対象セル.SpecialCells(xlCellTypeFormulas)
          Set vv検索結果セル = LinkCellSearch(myRng)
          If Not vv検索結果セル Is Nothing Then
               If vvリンクセル Is Nothing Then
                    Set vvリンクセル = vv検索結果セル
               Else
                    Set vvリンクセル = Union(vvリンクセル, vv検索結果セル)
               End If
          End If
     Next
On Error GoTo 0
     If Not vvリンクセル Is Nothing Then vvリンクセル.Font.Color = -11489280
     With vv検索対象セル
          .Parent.ClearArrows
          .Parent.Activate
          .Activate
     End With
End Sub
'*******************************************************************************
'処理内容 : 別シートのセルを参照しているセルオブジェクトを返す。別ブックは対象外
'引数 : vv計算式セル：何らかの数式を含んだセルを受け取る
'*******************************************************************************
Private Function LinkCellSearch(vv計算式セル As Range) As Range
     Dim vv参照元セル As Range
     Dim vvリンクセル As Range
     Dim i As Long: i = 1
     Dim n As Long: n = 1
     
On Error Resume Next
     vv計算式セル.ShowPrecedents
     For i = 1 To 32767  'LinkNumberが32,767まで受け付けるのでそれに合わせた。直接参照元矢印がこれだけ出ることはないだろう。
          Do
               Set vv参照元セル = vv計算式セル.NavigateArrow(towardprecedent:=True, arrownumber:=i, linknumber:=n)
               If vv参照元セル Is Nothing Then Exit Do  '次の参照元矢印に処理を移動
               
               '参照元が存在しない矢印の場合・外部シートへのリンクがあった場合、次のセルに処理を移動
               If vv計算式セル.Parent.Name & ":" & vv計算式セル.Address = vv参照元セル.Parent.Name & ":" & vv参照元セル.Address Then Exit For
               If vv計算式セル.Parent.Name <> vv参照元セル.Parent.Name Then Set vvリンクセル = vv計算式セル: Exit For
               Set vv参照元セル = Nothing
               n = n + 1
          Loop
     Next
On Error GoTo 0
     Set LinkCellSearch = vvリンクセル
End Function