EXCEL VBA 循環参照の検索・データの正確性を確保: 循環参照その回避策・エラー原因の解決　（テクニック）

2023年11月3日

EXCEL VBA 循環参照の検索・データの正確性を確保: 循環参照その回避策・エラー原因の解決　（テクニック）

●はじめに

今回説明するサンプルプログラムは、ワークシート上に循環参照があるときに、循環参照場所をセル番号で検索する事ができるサンプルプログラムを紹介いたします。事務処理業務において、Excelはデータの集計、分析、レポート作成などの多岐にわたるタスクで頻繁に使用されます。特に、複雑な計算や多数のデータを扱う際には、セル間の参照が増え、誤って循環参照を作成するリスクが高まります。循環参照は、あるセルが直接または間接的に自分自身を参照することを意味し、これが存在すると正確な計算ができなくなるため、業務上の重大な誤りを引き起こす可能性があります。

このVBAプログラムは、は、シート内の循環参照を迅速に検出するためのものです。事務処理業務でこのコードを使用する理由は、データの正確性を確保し、業務の効率を向上させるためです。循環参照が存在すると、その影響を受けるセルの計算結果が信頼できなくなり、結果としてレポートや分析の正確性が損なわれる可能性があります。このプログラムを定期的に実行することで、循環参照を早期に発見し、修正することができます。これにより、データの品質を維持し、業務の信頼性を高めることができるのです。それでは、サンプルプログラムを交えて順番に説明いたします。

●【Worksheet.CircularReference プロパティ (Excel)、下記を参照して下さい】（Microsoft社　様）】
https://learn.microsoft.com/ja-jp/office/vba/api/excel.worksheet.circularreference

EXCEL VBA ワークシートの循環参照をチェックし事務処理業務の信頼性を高める方法 ①

●プログラム説明　(サンプル①)

このVBAコードは、Excelのシート上の循環参照を検出するためのものです。循環参照とは、セルが自分自身を参照するか、または他のセルを参照し、その参照が最終的に元のセルに戻るような参照のことを指します。このコードには、メインのサブルーチン「FindCircularReferences」と、循環参照を検出するための関数「HasCircularReference」が含まれています。

【プログラムの流れ】

①FindCircularReferences サブルーチンが実行される。
②アクティブシートの使用範囲を rng に設定する。
③rng の各セルに対して、HasCircularReference 関数を使用して循環参照があるかどうかを確認する。
④循環参照が見つかった場合、メッセージボックスでそのセルのアドレスを表示し、サブルーチンを終了する。
⑤全てのセルを確認した後、循環参照が見つからなかった場合、メッセージボックスでその旨を表示する。

HasCircularReference 関数の動作の流れ：
①引数として与えられたセルの式を formula に格納する。
②そのセルの直接の依存先を references に設定する。
③references の各セルに対して、formula 内にそのセルのアドレスが含まれているかを確認する。
④セルのアドレスが formula 内に含まれていた場合、Trueを返す。
⑤全ての依存先セルを確認した後、循環参照が見つからなかった場合、Falseを返す。

【プログラム実行条件・注意事項】
実行条件：このプログラムを実行する前に、ExcelのVBAエディタで該当のシートをアクティブにしておく必要があります。
注意事項：このプログラムは、最初に見つかった循環参照のみを報告します。複数の循環参照がある場合、最初の1つだけが報告され、その後の処理は停止します。

★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。
●　findcircularreference01（サンプルプログラム）

'
'
'
Option Explicit

Sub FindCircularReferences() '循環参照を見つける1カ所
    Dim rng As Range
    Dim cell As Range
    
    Set rng = ActiveSheet.UsedRange ' 検索範囲をシートの使用範囲に設定
    
    For Each cell In rng
        If HasCircularReference(cell) Then
            MsgBox "循環参照が見つかりました。セル " & cell.Address & " に循環参照があります。"
            Exit Sub ' 循環参照が見つかったら処理を終了
        End If
    Next cell
    
    MsgBox "循環参照は見つかりませんでした。"
End Sub

Function HasCircularReference(cell As Range) As Boolean
    Dim formula As String
    Dim references As Range
    Dim refCell As Range
    
    formula = cell.formula
    Set references = cell.DirectPrecedents ' セルの直接の依存先を取得
    
    For Each refCell In references
        If InStr(formula, refCell.Address(False, False)) > 0 Then
            HasCircularReference = True
            Exit Function ' 循環参照が見つかったらTrueを返して終了
        End If
    Next refCell
    
    HasCircularReference = False ' 循環参照が見つからなかった場合はFalseを返す
End Function
'
'

Option Explicit

Sub FindCircularReferences() '循環参照を見つける1カ所

Dim rng As Range

Dim cell As Range

Set rng = ActiveSheet.UsedRange ' 検索範囲をシートの使用範囲に設定

For Each cell In rng

If HasCircularReference(cell) Then

MsgBox "循環参照が見つかりました。セル " & cell.Address & " に循環参照があります。"

Exit Sub ' 循環参照が見つかったら処理を終了

End If

Next cell

MsgBox "循環参照は見つかりませんでした。"

End Sub

Function HasCircularReference(cell As Range) As Boolean

Dim formula As String

Dim references As Range

Dim refCell As Range

formula = cell.formula

Set references = cell.DirectPrecedents ' セルの直接の依存先を取得

For Each refCell In references

If InStr(formula, refCell.Address(False, False)) > 0 Then

HasCircularReference = True

Exit Function ' 循環参照が見つかったらTrueを返して終了

End If

Next refCell

HasCircularReference = False ' 循環参照が見つからなかった場合はFalseを返す

End Function

●実行前～実行後　※プログラム実行後、条件により以下の通りに実行されます。
・循環参照が見つかった場合：メッセージボックスが表示され、循環参照が見つかったセルのアドレスが表示されます。
・循環参照が見つからなかった場合：メッセージボックスが表示され、循環参照が見つからなかったことが表示されます。
（画面クリックして拡大）

EXCEL VBA ワークシートの循環参照をチェックし事務処理業務の信頼性を高める方法 ②（複数の循環参照を見つける）

●プログラム説明　(サンプル②)

下記のサンプルプログラムは、サンプルプログラム①の応用になります。今回のサンプルプログラムでは、ワークシート上（アクティブシート）に有る全ての循環参照が発生している場所を見つける事ができます。循環参照は、セルが直接または間接に自身を参照することで発生し、計算エラーの原因になります。このコードはFindCircularReferences02というサブルーチンと、循環参照があるかどうかを調べるための補助関数HasCircularReference02から構成されています。自動的に複数個所で循環参照が発生した時に簡単に発見する事ができます。

【プログラムの流れ】
1.アクティブシートの使用されている範囲をrngとして設定します。
2.circularCellsコレクションを初期化し、見つかった循環参照のセルの経路を格納します。
3.使用範囲内の各セルについて以下の処理を行います：
a. visitedCellsコレクションを初期化します。
b. HasCircularReference02関数を使用して、そのセルが循環参照を持っているかをチェックします。
c. 循環参照がある場合は、visitedCellsをcircularCellsコレクションに追加します。
4.循環参照が1つ以上見つかった場合は、メッセージボックスに循環参照の情報を表示します。
5.循環参照が見つからなかった場合は、「循環参照は見つかりませんでした。」というメッセージボックスを表示します。

HasCircularReference02関数は以下の処理を行います。1.与えられたセルの式を取得します。
2.セルの直接の依存先をreferencesとして取得します。
3.依存先がない場合は、Falseを返して処理を終了します。
4.訪問済みのセルをチェックして、もし現在のセルがすでに訪問済みならTrueを返して処理を終了します。
5.訪問済みのセルに現在のセルを追加します。
6.依存先のセルそれぞれに対して再帰的にHasCircularReference02関数を呼び出します。
7.循環参照が見つかった場合は、Trueを返して処理を終了します。
8.循環参照が見つからない場合は、最後に追加したセルをvisitedCellsから削除し、Falseを返します。

【プログラム実行条件・注意事項】
1.このプログラムはActiveSheetにのみ動作するため、処理するシートがアクティブであることを確認する必要があります。
2.DirectPrecedentsを使用しているため、直接の参照先のみを確認します。間接的な参照は検出されません。
3.On Error Resume Nextはエラーが発生した際にエラーを無視して次の処理行へ進むため、予期しない動作を引き起こす可能性があります。
4.コレクションに同じセルを複数回追加しないように注意する必要があります。これはコード内で管理されているはずですが、ロジックに誤りがあると問題が生じる可能性があります。

★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。
●　findcircularreference02　（サンプルプログラム）

'
'
Option Explicit

Sub FindCircularReferences02() '複数個所
    Dim rng As Range
    Dim cell As Range
    
    Set rng = ActiveSheet.UsedRange ' 検索範囲をシートの使用範囲に設定
    
    Dim circularCells As Collection
    Set circularCells = New Collection ' 循環参照があるセルを格納するコレクション
    
    For Each cell In rng
        Dim visitedCells As Collection
        Set visitedCells = New Collection
        If HasCircularReference02(cell, visitedCells) Then
            circularCells.Add visitedCells ' 循環参照があるセルの経路をコレクションに追加
        End If
    Next cell
    
    If circularCells.Count > 0 Then
        Dim msg As String
        msg = "循環参照が見つかりました。" & vbCrLf
        
        Dim i As Long
        For i = 1 To circularCells.Count
            Dim circularPath As Collection
            Set circularPath = circularCells.Item(i)
            
            msg = msg & "セル " & circularPath.Item(1).Address & " を含む循環参照:"
            
            'Dim j As Long
            'For j = 1 To circularPath.Count
            '    msg = msg & vbCrLf & circularPath.Item(j).Address
            'Next j
            
            msg = msg & vbCrLf
        Next i
        
        MsgBox msg
    Else
        MsgBox "循環参照は見つかりませんでした。"
    End If
End Sub

Function HasCircularReference02(cell As Range, visitedCells As Collection) As Boolean
    Dim formula As String
    Dim references As Range
    Dim refCell As Range
    
    formula = cell.formula
    
    On Error Resume Next
    Set references = cell.DirectPrecedents ' セルの直接の依存先を取得
    On Error GoTo 0
    
    If references Is Nothing Then
        HasCircularReference02 = False
        Exit Function
    End If
    
    On Error Resume Next
    Set refCell = visitedCells.Item(visitedCells.Count)
    On Error GoTo 0
    
    If Not refCell Is Nothing Then
        If refCell.Address = cell.Address Then
            HasCircularReference02 = True
            Exit Function ' 循環参照が見つかったらTrueを返して終了
        End If
    End If
    
    visitedCells.Add cell
    
    For Each refCell In references
        If HasCircularReference02(refCell, visitedCells) Then
            HasCircularReference02 = True
            Exit Function ' 循環参照が見つかったらTrueを返して終了
        End If
    Next refCell
    
    visitedCells.Remove visitedCells.Count ' 循環参照ではない場合は追加したセルを削除
    
    HasCircularReference02 = False ' 循環参照が見つからなかった場合はFalseを返す
End Function
'
'

Option Explicit

Sub FindCircularReferences02() '複数個所

Dim rng As Range

Dim cell As Range

Set rng = ActiveSheet.UsedRange ' 検索範囲をシートの使用範囲に設定

Dim circularCells As Collection

Set circularCells = New Collection ' 循環参照があるセルを格納するコレクション

For Each cell In rng

Dim visitedCells As Collection

Set visitedCells = New Collection

If HasCircularReference02(cell, visitedCells) Then

circularCells.Add visitedCells ' 循環参照があるセルの経路をコレクションに追加

End If

Next cell

If circularCells.Count > 0 Then

Dim msg As String

msg = "循環参照が見つかりました。" & vbCrLf

Dim i As Long

For i = 1 To circularCells.Count

Dim circularPath As Collection

Set circularPath = circularCells.Item(i)

msg = msg & "セル " & circularPath.Item(1).Address & " を含む循環参照:"

'Dim j As Long

'For j = 1 To circularPath.Count

' msg = msg & vbCrLf & circularPath.Item(j).Address

'Next j

msg = msg & vbCrLf

Next i

MsgBox msg

Else

MsgBox "循環参照は見つかりませんでした。"

End If

End Sub

Function HasCircularReference02(cell As Range, visitedCells As Collection) As Boolean

Dim formula As String

Dim references As Range

Dim refCell As Range

formula = cell.formula

On Error Resume Next

Set references = cell.DirectPrecedents ' セルの直接の依存先を取得

On Error GoTo 0

If references Is Nothing Then

HasCircularReference02 = False

Exit Function

End If

On Error Resume Next

Set refCell = visitedCells.Item(visitedCells.Count)

On Error GoTo 0

If Not refCell Is Nothing Then

If refCell.Address = cell.Address Then

HasCircularReference02 = True

Exit Function ' 循環参照が見つかったらTrueを返して終了

End If

visitedCells.Add cell

For Each refCell In references

If HasCircularReference02(refCell, visitedCells) Then

HasCircularReference02 = True

Exit Function ' 循環参照が見つかったらTrueを返して終了

End If

Next refCell

visitedCells.Remove visitedCells.Count ' 循環参照ではない場合は追加したセルを削除

HasCircularReference02 = False ' 循環参照が見つからなかった場合はFalseを返す

End Function

●実行前～実行後 ※プログラム実行後、条件により以下の通りに実行されます。
・循環参照がシートに存在する場合:メッセージボックスが表示され、「循環参照が見つかりました。」と報告し、循環参照を含むセルのアドレスをリストアップします。
・循環参照が見つからない場合は:「循環参照は見つかりませんでした。」というメッセージボックスが表示されます。（画面クリックして拡大）