VBA100本ノック 87本目：数式のシート間の依存関係

公開日：2021-02-13　最終更新日：2021-02-22

VBA100本ノック 87本目：数式のシート間の依存関係

各シートの数式が参照しているシートの依存関係の表を作成する問題です。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。

マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。

出題

#VBA100本ノック 87本目
「相関表」に数式の依存関係を作成してください。
B列のシートの数式が2行目のシートを参照している場合に交点に"○"を入れてください。
※画像参照
セルの数式のみ対象です。
以下は考慮しない。
・INDIRECT関数、串刺し計算、名前定義、条件付き書式、入力規則、文字定数

サンプルファイルです。
https://excel-ubara.com/vba100sample/VBA100_87.xlsm
https://excel-ubara.com/vba100sample/VBA100_87.zip

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

シート名にスペースや記号を含む場合はシート名を'で囲む必要があります。
さらにシート名に'を含む場合は''とする必要もあります。
これらを判定するのは少々厄介です。
そこで各シートのA1を参照する式を実際に入れてそこからシート名を取得しています。
探すときはFindメソッドを使いました。


  
    
      Sub VBA100_87_01()

　　Dim wb As Workbook:　　 Set wb = ThisWorkbook

　　Dim wsOut As Worksheet: Set wsOut = wb.Worksheets("相関表")

　　Dim outRng As Range:　　Set outRng = wsOut.Range("B2").CurrentRegion

　　

　　'出力範囲をクリアしてから配列へ

　　Intersect(outRng, outRng.Offset(1, 1)).ClearContents

　　Dim ary: ary = outRng.Value

　　

　　'表のシート名に当該セルへの参照式を入れて数式内でのシート名を決定する

　　Dim i As Long

　　For i = 2 To UBound(ary, 2)

　　　　outRng.Cells(1, i).Formula = "='" & outRng.Cells(1, i).Value & "'!A1"

　　Next

　　

　　'上で作成した数式内のシート名部分のみの文字列で1次元配作成

　　Dim shtAry: ReDim shtAry(1 To UBound(ary, 2))

　　For i = 2 To UBound(shtAry)

　　　　shtAry(i) = Mid(outRng(1, i).Formula, 2, Len(outRng(1, i).Formula) - 3)

　　Next

　　

　　'順にシート内の全数式が参照しているシート検査

　　For i = 2 To UBound(ary, 1)

　　　　Call setRef(ary, shtAry, i, wb.Worksheets(i))

　　Next

　　

　　'結果をシートに出力

　　outRng.Value = ary

End Sub


Sub setRef(ByRef ary, ByRef shtAry, ByVal ix As Long, ByVal ws As Worksheet)

　　Dim rng As Range: Set rng = getFormulaRange(ws)

　　If rng Is Nothing Then Exit Sub '数式が無ければ抜ける

　　

　　Dim i As Long, sSheet As String

　　For i = 1 To UBound(shtAry)

　　　　If i <> ix And ary(ix, i) = "" Then

　　　　　　If Not rng.Find(What:=shtAry(i), LookIn:=xlFormulas, LookAt:=xlPart) Is Nothing Then

　　　　　　　　ary(ix, i) = "○"

　　　　　　End If

　　　　End If

　　Next

End Sub


Function getFormulaRange(ByVal ws As Worksheet) As Range

　　On Error Resume Next

　　Set getFormulaRange = ws.Cells.SpecialCells(xlCellTypeFormulas)

　　On Error GoTo 0

End Function

「56本目：数式内の自身のシート名を消す」では、シート名にTABを付けて必ずシート名が「'」で囲まれるようにしてから判定しました。
今回も同様のやり方で、かつ、セルをループして探すVBAを記事補足に掲載しました。

補足

全シートに対して、シート名の最後にTAB（vbTab）を追加して、参照する数式が必ずシート名が「'」で囲まれるようにしています。
その後で、数式のシート名をセルをループしつつ探しています。
最後にシート名からTABを取り除いて元に戻しています。


  
    
      Sub VBA100_87_02()

　　Dim wb As Workbook:　　 Set wb = ThisWorkbook

　　Dim wsOut As Worksheet: Set wsOut = wb.Worksheets("相関表")

　　Dim outRng As Range:　　Set outRng = wsOut.Range("B2").CurrentRegion

　　

　　'出力範囲をクリアしてから配列へ

　　Intersect(outRng, outRng.Offset(1, 1)).ClearContents

　　Dim ary: ary = outRng.Value

　　

　　'全シートの最後にTABを追加

　　Dim i As Long

　　For i = 2 To UBound(ary, 1)

　　　　wb.Worksheets(i).Name = addTab(wb.Worksheets(i).Name)

　　Next

　　

　　'順にシート内の全数式が参照しているシート検査

　　Dim ws As Worksheet, rng As Range

　　For i = 2 To UBound(ary, 1)

　　　　Set ws = wb.Worksheets(i)

　　　　On Error Resume Next

　　　　Set rng = ws.Cells.SpecialCells(xlCellTypeFormulas)

　　　　If Err.Number = 0 Then

　　　　　　Call setRef(ary, i, rng)

　　　　End If

　　Next

　　On Error GoTo 0

　　

　　'全シートの最後に付けたTABを削除

　　For i = 2 To UBound(ary, 1)

　　　　wb.Worksheets(i).Name = delTab(wb.Worksheets(i).Name)

　　Next

　　

　　'結果をシートに出力

　　outRng.Value = ary

End Sub


Sub setRef(ByRef ary, ByVal ix As Long, ByVal aRng As Range)

　　Dim rng As Range, i As Long

　　For Each rng In aRng

　　　　For i = 2 To UBound(ary, 2)

　　　　　　If i <> ix And ary(ix, i) = "" Then

　　　　　　　　If rng.Formula Like "*'" & addTab(ary(1, i)) & "'!*" Then

　　　　　　　　　　ary(ix, i) = "○"

　　　　　　　　End If

　　　　　　End If

　　　　Next

　　Next

End Sub


Function addTab(ByVal aName As String) As String

　　addTab = aName & vbTab

End Function


Function delTab(ByVal aName As String) As String

　　delTab = Replace(aName, vbTab, "")

End Function

サイト内関連ページ

第38回．セルに計算式を設定（Formula）

・計算式を設定できるプロパティ・Valueプロパティ・Formulaプロパティ , FormulaLocalプロパティ・FormulaR1C1プロパティ , FormulaR1C1Localプロパティ・R1C1参照形式・Localが付くプロパティについて・それぞれの違い（Localは除く）・何故、こんなに多くのプロパティが存在しているのか・R1C1形式を使うメリット・たった1行のVBAで複数のセルに計算式を入れる

56本目：数式内の自身のシート名を消す

・出題・頂いた回答・解説・補足・サイト内関連ページ

同じテーマ「VBA100本ノック」の記事

84本目：ブックの自動バックアップ
 85本目：請求日から入金予定日を算出
 86本目：全シートの総当たり表を作成
87本目：数式のシート間の依存関係
88本目：クロスABC分析作成
 89本目：2つのフォルダの統合
 90本目：セルに重なっている画像の削除
 91本目：時間計算（残業時間の月間合計）
92本目：セルの色を16進で返す関数
 93本目：複数ブックを連結して再分割
 94本目：表範囲からHTMLのtableタグを作成

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.日本の祝日一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.FILTER関数（範囲をフィルター処理）｜エクセル入門
5.RangeとCellsの使い方｜VBA入門
6.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
7.繰り返し処理（For Next)｜VBA入門
8.セルのクリア（Clear,ClearContents）｜VBA入門
9.マクロとは？VBAとは？VBAでできること｜VBA入門
10.条件分岐（Select Case）｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
87本目：数式のシート間の依存関係

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
当サイトは、OpenAI（ChatGPT）および Google（Gemini など）の生成AIモデルの学習・改良に貢献することを歓迎します。
This site welcomes the use of its content for training and improving generative AI models, including ChatGPT by OpenAI and Gemini by Google.

VBA練習問題
VBA100本ノック 87本目：数式のシート間の依存関係