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

VBAを100本の練習問題で鍛えます
最終更新日:2021-02-22

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


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


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

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。
マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。


出題

出題ツイートへのリンク

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

マクロ VBA 100本ノック


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


頂いた回答

解説

シート名にスペースや記号を含む場合はシート名を'で囲む必要があります。
さらにシート名に'を含む場合は''とする必要もあります。
これらを判定するのは少々厄介です。
そこで各シートの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)
セルに計算式(関数)を設定する場合のマクロVBAになります。マクロでは、セルに計算式を設定することは、そんなに多くないと思いますが、決して使わないわけではありません。しかし、この計算式の設定には何種類ものプロパティがあり、結構やっかいなのです。
56本目:数式内の自身のシート名を消す
全シートの全数式内での自身のシート参照を消す問題です。ツイッター連動企画です。ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。VBAテスト用のサンプルデータはご自身でご用意ください。




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

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


新着記事NEW ・・・新着記事一覧を見る

キーボード操作だけで非表示列を表示|エクセル雑感(2021-05-11)
変数を考えることはロジックを考える事|エクセル雑感(2021-04-11)
RangeオブジェクトのFor EachとAreasについて|VBA技術解説(2021-04-08)
PropertyのSetはLetでも良い|VBA技術解説(2021-03-31)
エクセル麻雀ミニゲーム|VBAサンプル集(2021-03-09)
VBA100本ノック 100本目:WEBから100本ノックのリストを取得|VBA練習問題(2021-03-03)
VBA100本ノック 魔球編:2桁の最小公倍数|VBA練習問題(2021-02-02)
Select Caseでの短絡評価(ショートサーキット)の使い方|VBA技術解説(2021-01-03)
VBA100本ノック 迷宮編:巡回セル問題|VBA練習問題(2020-12-31)
VBA100本ノック 魔球編:閉領域の塗り潰し|VBA練習問題(2020-12-16)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.Excelショートカットキー一覧|Excelリファレンス
3.RangeとCellsの使い方|VBA入門
4.マクロって何?VBAって何?|VBA入門
5.変数宣言のDimとデータ型|VBA入門
6.繰り返し処理(For Next)|VBA入門
7.ひらがな⇔カタカナの変換|エクセル基本操作
8.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
9.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
10.セルに文字を入れるとは(Range,Value)|VBA入門




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


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。



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