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.繰り返し処理（For Next)｜VBA入門
7.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
8.マクロとは？VBAとは？VBAでできること｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.メッセージボックス(MsgBox関数)｜VBA入門

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

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

記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。
This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.

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