ぼくLog

子持ち、車持ち、マンション持ちの僕の日常を綴ります。車と、ラクをしたい一心で覚えたエクセルVBAを中心になりそうです。

エクセルの表が大きい時は行と列のハイライトで分かりやすくする|エクセルVBA

エクセルで行方向、列方向に数多くのデータが並ぶ、とにかく大きな表に出くわした、もしくは作らざるを得なかったことはありませんか?

例えばこのような表です。

f:id:yt4u:20160913235214j:plain


大きな表になってしまうのは、諸事情があるのでそれ自体を否定するわけではありません。

ただそのような大きな表の中で、自分が何番目の行の、何番目の列にいるのか、分からなくなってしまうことが容易に想像できます。

そんなとき、表がハイライトされたらいいのにと思ったことはありませんか?


ということで、ハイライト機能を実装する方法を考えてみました。

完成形のイメージはこんなカンジです。

f:id:yt4u:20160917213728j:plain

先にコードを見てもらい、その後で内容について説明します。



ハイライト機能の構成


メイン部分をクラスモジュールで用意


クラスモジュール「blClsHighLight」

Option Explicit

Private WithEvents mwsTarget      As Worksheet
Private mrngHighLight             As Range  'ハイライト有効レンジ

Private mrngSelectedRow           As Range  'ハイライトされた行
Private mrngSelectedCol           As Range  'ハイライトされた列
Private mrngSelected              As Range  'ハイライトされたセル

'ハイライトカラーRGB指定(RGB文字列とそれを格納する配列を用意)
Private Const mcRowHLColor        As String = "255,230,153"     '行ハイライト色(R,G,B)
Private Const mcColHLColor        As String = "255,242,204"     '列ハイライト色(R,G,B)
Private Const mcCellHLColor       As String = "255,217,102"     'セルハイライト色(R,G,B)
Private mstrRowHLColor()          As String
Private mstrColHLColor()          As String
Private mstrCellHLColor()         As String


Private Sub Class_Initialize()

  'RGB文字列を配列に変換
  mstrRowHLColor = Split(mcRowHLColor, ",")
  mstrColHLColor = Split(mcColHLColor, ",")
  mstrCellHLColor = Split(mcCellHLColor, ",")

End Sub


Private Sub Class_Terminate()

  Set mwsTarget = Nothing
  Set mrngHighLight = Nothing
  Set mrngSelectedRow = Nothing
  Set mrngSelectedCol = Nothing
  Set mrngSelected = Nothing

End Sub


'==========================================================
'ハイライト機能を持たせるシートを取得
'==========================================================
Public Property Set TargetSheet(HighLightSheet As Worksheet)

  Set mwsTarget = HighLightSheet
  
End Property


'==========================================================
'ハイライト有効レンジを取得
'==========================================================
Public Property Set HighLightArea(HighLightRange As Range)

  Set mrngHighLight = HighLightRange
  
  'ハイライト有効レンジの色塗りをクリア
  mrngHighLight.Interior.Color = xlNone
  
End Property


'==========================================================
'mwsTargetのSelectionChangeイベント
'==========================================================
Private Sub mwsTarget_SelectionChange(ByVal Target As Range)

  On Error GoTo ERR_PROC
      
  'ハイライトのクリア
  Call clearHighLight(Target)
    
    
  'ハイライト実行
  Call doHighLight(Target)


  GoTo END_PROC
ERR_PROC:
  mrngHighLight.Interior.Color = xlNone

END_PROC:

End Sub


'==========================================================
'ハイライトのクリア
'==========================================================
Private Sub clearHighLight(Target As Range)


  With mwsTarget


    'ハイライトされた行とTarget行が一致しない場合は
    'ハイライトされた行の色塗りをクリア
    If Not mrngSelectedRow Is Nothing Then
    
      If Target.Row <> mrngSelectedRow.Row Then
      
        mrngSelectedRow.Interior.Color = xlNone
      
      End If
    
    End If
  
  
    
    'ハイライトされた列とTarget列が一致しない場合は
    'ハイライトされた列の色塗りをクリア
    If Not mrngSelectedCol Is Nothing Then
    
      If Target.Column <> mrngSelectedCol.Column Then
      
        mrngSelectedCol.Interior.Color = xlNone
        
      End If
    
    End If
    
  
    'ハイライトされたセルとTargetセルが一致しない場合は
    'ハイライトされたセルの色塗りをクリア
    If Not mrngSelected Is Nothing Then
    
      If Target.Address <> mrngSelected.Address Then
      
        mrngSelected.Interior.Color = xlNone
        
      End If
  
    End If
    
    
  End With
  
End Sub


'==========================================================
'ハイライト実行
'==========================================================
Private Sub doHighLight(Target As Range)

  With mwsTarget
    
    
    'Targetとハイライトエリアが重複していた場合
    If Not Application.Intersect(Target, mrngHighLight) Is Nothing Then
    
      '行のハイライト
      With Application.Intersect(.Rows(Target.Row), mrngHighLight)
      
        .Interior.Color = RGB(mstrRowHLColor(0), mstrRowHLColor(1), mstrRowHLColor(2))
        
        Set mrngSelectedRow = .Cells
        
      End With
    
    
      '列のハイライト
      With Application.Intersect(.Columns(Target.Column), mrngHighLight)
      
        .Interior.Color = RGB(mstrColHLColor(0), mstrColHLColor(1), mstrColHLColor(2))
        
        Set mrngSelectedCol = .Cells
        
      End With
      
        
      'セルのハイライト
      With Application.Intersect(Target, mrngHighLight)
      
        .Interior.Color = RGB(mstrCellHLColor(0), mstrCellHLColor(1), mstrCellHLColor(2))
        
        Set mrngSelected = .Cells
      
      End With
      
    
    Else 'Targetとハイライトエリアが重複していない場合
    
      mrngHighLight.Color = xlNone
    
    End If
  
  End With


End Sub

クラスモジュールを使わずにシートモジュールを使う方法も考えられます
ただ、ハイライト機能を持たせるシートが1つだけとは限りません。
ハイライトシートが複数あって、それぞれに同じコードを書くのは無駄ですよね。
コード修正が必要になった時なんてシートの数だけ同じ修正が必要で余計な労力がかかりますから尚更です。


ハイライトクラスを呼び出すSubプロシージャを用意

ハイライトさせるシートとレンジを設定します。
ここではハイライトさせるレンジに予め「rngHL_HighLight」と名前をつけています。


標準モジュール「blMdlHighLight」

Option Explicit

Public gclsHighLight              As blClsHighLight


Public Sub setHighLight()

  'ハイライトクラスのインスタンスを生成
  Set gclsHighLight = New blClsHighLight
  
  'ハイライトシートを設定
  Set gclsHighLight.TargetSheet = wsHighLight
  
  'ハイライトレンジを設定
  Set gclsHighLight.HighLightArea = wsHighLight.Range("rngHL_HighLight")

End Sub


Subプロシージャ「setHighLight」をWorkbook_Open時に実行

Workbookを開くと同時にハイライト機能を呼び出し、閉じるときに破棄するようにします。
上述のSubプロシージャを「ThisWorkbook」モジュール内で完結させることも可能ですが、分けておいた方がすっきりして見やすくなると思います。


「ThisWorkbook」モジュール

Option Explicit

Private Sub Workbook_Open()

  Call setHighLight
  
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

  Set gclsHighLight = Nothing

End Sub



ハイライト機能は名脇役

シート上に存在する表やデータをどう使うかが一番の目的であることは言うまでもありません。
なので、ハイライトは決して必須の機能ではなく、あくまで脇役。

とはいえ、自分が作ったちょっと大きな表を他の人も見ることになったとき、そこにハイライト機能があったら「コイツやるな」と思われること間違いなし!

ハイライト機能は、同じシートを複数人で共有するときに活きてくる名脇役なのです。


なお、自分以外の人が同じエクセルを弄ることになると予期せぬエラーはつきもの。
エラーが発生すると、ハイライトクラスが破棄されてハイライト機能も動かなくなる可能性があります。
そんなときのために次善の策を打っておいてもいいかもしれません。

例えば、ハイライト機能を持たせたシートのシートモジュールを使って、ハイライトクラスが破棄されていたら再度生成する方法が考えられます。

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  If gclsHighLight Is Nothing Then

    Call setHighLight

  End If

End Sub

シートモジュールを使うのは何かと面倒だからクラスモジュールを使って、、、
という方針とはやや矛盾している点は無視してください(汗