Excel VBA でアクティブセルとその行・列をハイライトする方法（改良版）

概要

このVBAコードは、Excelでアクティブセルとその行および列をハイライトする機能を提供します。コードはパフォーマンスを考慮して最適化され、色のカスタマイズや処理の一時停止、デバッグ機能などの高度なオプションが追加されています。

主な特徴

  • 最大行・列数をカスタマイズ：ユーザーはシートごとに最大行数や最大列数を指定できます。
  • ハイライトカラーの調整：アクティブセルや行・列の色を動的に調整できます。
  • デバッグ機能：処理の動作を確認するためにデバッグログを出力できます。
  • 一時停止機能：必要に応じてハイライト処理を停止・再開できます。
  • 複数シート対応：複数のシートを跨いで動作します。

実装方法

  1. VBAエディタにコードを追加 ExcelのVBAエディタを開き、以下のコードを追加してください。
    1. クラスモジュール（clsHighlighter）
' clsHighlighter クラスモジュール
Option Explicit

Private WithEvents app As Application
Private cellColors As Object
Private prevSelection As Range
Private stopHighlighting As Boolean
Private debugMode As Boolean

' 初期化
Public Sub Init(Optional ByVal maxRow As Long = 100, Optional ByVal maxCol As Long = 26, Optional ByVal colorRatio As Double = 0.1)
    Set app = Application
    Set cellColors = CreateObject("Scripting.Dictionary")
    stopHighlighting = False ' 初期状態ではハイライト処理を有効
    debugMode = False ' デバッグモードはデフォルトでオフ
    
    ' 最大行・列数、色の割合を設定
    ThisWorkbook.Names.Add Name:="MaxRows", RefersTo:=maxRow
    ThisWorkbook.Names.Add Name:="MaxCols", RefersTo:=maxCol
    ThisWorkbook.Names.Add Name:="ColorRatio", RefersTo:=colorRatio
End Sub

' ハイライト処理を停止する
Public Sub StopHighlighting()
    stopHighlighting = True
End Sub

' ハイライト処理を再開する
Public Sub ResumeHighlighting()
    stopHighlighting = False
End Sub

' デバッグモードを有効化
Public Sub EnableDebugMode()
    debugMode = True
End Sub

' デバッグモードを無効化
Public Sub DisableDebugMode()
    debugMode = False
End Sub

' セルの選択が変わると発生するイベント
Private Sub app_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim ws As Worksheet
    Dim c As Range, key As String
    Dim currentColor As Long
    Dim maxRow As Long, maxCol As Long
    Dim colorRatio As Double
    Dim limitRange As Range

    If stopHighlighting Then Exit Sub ' ハイライト処理が停止されていれば終了

    ' デバッグモードの場合、ログを出力
    If debugMode Then
        Debug.Print "Sheet: " & Sh.Name & ", Target: " & Target.Address
    End If
    
    ' ここで最大行、最大列、色の割合を取得
    maxRow = ThisWorkbook.Names("MaxRows").RefersToRange.Value
    maxCol = ThisWorkbook.Names("MaxCols").RefersToRange.Value
    colorRatio = ThisWorkbook.Names("ColorRatio").RefersToRange.Value
    
    ' アクティブシートの範囲を制限
    Set limitRange = HighlightRange(Sh, Target, maxRow, maxCol)

    ' 以前のセルの色を戻す
    If Not prevSelection Is Nothing Then
        For Each c In HighlightRange(Sh, prevSelection, maxRow, maxCol)
            key = Sh.Name & "!" & c.Address
            If cellColors.exists(key) Then
                currentColor = c.Interior.Color
                If currentColor = MixColor(cellColors(key), RGB(255, 255, 0), colorRatio) _
                   Or currentColor = MixColor(cellColors(key), RGB(255, 100, 100), colorRatio * 2) Then
                    c.Interior.Color = cellColors(key)
                End If
                cellColors.Remove key
            End If
        Next c
    End If

    ' 新しいセル範囲をハイライト
    For Each c In limitRange
        key = Sh.Name & "!" & c.Address
        If Not cellColors.exists(key) Then
            cellColors.Add key, c.Interior.Color
        End If
        c.Interior.Color = MixColor(cellColors(key), RGB(255, 255, 0), colorRatio)
    Next c

    ' アクティブセル自体をハイライト
    key = Sh.Name & "!" & Target.Address
    If Not cellColors.exists(key) Then
        cellColors.Add key, Target.Interior.Color
    End If
    Target.Interior.Color = MixColor(cellColors(key), RGB(255, 100, 100), colorRatio * 2)

    Set prevSelection = Target
End Sub

' 色を混ぜる関数（カラーレシピの変更が簡単）
Function MixColor(baseColor As Long, highlightColor As Long, ratio As Double) As Long
    Dim r1 As Long, g1 As Long, b1 As Long
    Dim r2 As Long, g2 As Long, b2 As Long
    Dim r As Long, g As Long, b As Long

    r1 = baseColor Mod 256
    g1 = (baseColor \ 256) Mod 256
    b1 = (baseColor \ 65536) Mod 256

    r2 = highlightColor Mod 256
    g2 = (highlightColor \ 256) Mod 256
    b2 = (highlightColor \ 65536) Mod 256

    r = r1 * (1 - ratio) + r2 * ratio
    g = g1 * (1 - ratio) + g2 * ratio
    b = b1 * (1 - ratio) + b2 * ratio

    MixColor = RGB(r, g, b)
End Function

' ハイライト範囲を制限
Function HighlightRange(ws As Worksheet, target As Range, maxRow As Long, maxCol As Long) As Range
    Dim limitedRow As Range, limitedCol As Range
    Dim r As Long, c As Long

    r = target.Row
    c = target.Column

    If r <= maxRow Then
        Set limitedRow = ws.Range(ws.Cells(r, 1), ws.Cells(r, maxCol))
    End If
    If c <= maxCol Then
        Set limitedCol = ws.Range(ws.Cells(1, c), ws.Cells(maxRow, c))
    End If

    If Not limitedRow Is Nothing And Not limitedCol Is Nothing Then
        Set HighlightRange = Union(limitedRow, limitedCol)
    ElseIf Not limitedRow Is Nothing Then
        Set HighlightRange = limitedRow
    ElseIf Not limitedCol Is Nothing Then
        Set HighlightRange = limitedCol
    Else
        Set HighlightRange = ws.Range("A1")
    End If
End Function
  1. 標準モジュール（modHighlighter）
' modHighlighter モジュール
Option Explicit

Public Highlighter As clsHighlighter

' ハイライト処理を開始する
Sub StartHighlighter()
    Set Highlighter = New clsHighlighter
    Highlighter.Init maxRow:=100, maxCol:=26, colorRatio:=0.1
End Sub

' ハイライト処理を一時停止する
Sub StopHighlighting()
    Highlighter.StopHighlighting
End Sub

' ハイライト処理を再開する
Sub ResumeHighlighting()
    Highlighter.ResumeHighlighting
End Sub

' デバッグモードを有効にする
Sub EnableDebugMode()
    Highlighter.EnableDebugMode
End Sub

' デバッグモードを無効にする
Sub DisableDebugMode()
    Highlighter.DisableDebugMode
End Sub

使い方

  1. ハイライト機能の開始:
    • StartHighlighter を実行して、アクティブセル、行、列のハイライト機能を開始します。
  2. ハイライトの停止/再開:
    • StopHighlighting で処理を停止し、ResumeHighlighting で再開します。
  3. デバッグ機能:
    • EnableDebugMode でデバッグモードを有効にすると、処理ログが表示されます。DisableDebugMode で無効にします。

結論

このコードは、Excelの作業を効率的にサポートするための強力なツールです。必要に応じて設定を変更し、ハイライト機能をカスタマイズして、より多くのシナリオに対応できるようにしました。

コメント

タイトルとURLをコピーしました