今回説明するサンプルプログラムは、ワークシート上に循環参照があるときに、循環参照場所をセル番号で検索する事ができるサンプルプログラムを紹介いたします。事務処理業務において、Excelはデータの集計、分析、レポート作成などの多岐にわたるタスクで頻繁に使用されます。特に、複雑な計算や多数のデータを扱う際には、セル間の参照が増え、誤って循環参照を作成するリスクが高まります。循環参照は、あるセルが直接または間接的に自分自身を参照することを意味し、これが存在すると正確な計算ができなくなるため、業務上の重大な誤りを引き起こす可能性があります。
このVBAプログラムは、は、シート内の循環参照を迅速に検出するためのものです。事務処理業務でこのコードを使用する理由は、データの正確性を確保し、業務の効率を向上させるためです。循環参照が存在すると、その影響を受けるセルの計算結果が信頼できなくなり、結果としてレポートや分析の正確性が損なわれる可能性があります。このプログラムを定期的に実行することで、循環参照を早期に発見し、修正することができます。これにより、データの品質を維持し、業務の信頼性を高めることができるのです。それでは、サンプルプログラムを交えて順番に説明いたします。
●【Worksheet.CircularReference プロパティ (Excel)、下記を参照して下さい】（Microsoft社 様）】
https://learn.microsoft.com/ja-jp/office/vba/api/excel.worksheet.circularreference
この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
'
'
下記のサンプルプログラムは、サンプルプログラム①の応用になります。今回のサンプルプログラムでは、ワークシート上（アクティブシート）に有る全ての循環参照が発生している場所を見つける事ができます。循環参照は、セルが直接または間接に自身を参照することで発生し、計算エラーの原因になります。このコードは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
'
'
