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

VBAを100本の練習問題で鍛えます
公開日:2021-02-13 最終更新日: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


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タグを作成


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

ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
累計を求める数式あれこれ|エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE|エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。|エクセル雑感(2023-12-28)
VBAでクリップボードへ文字列を送信・取得する3つの方法|VBA技術解説(2023-12-07)
難しい数式とは何か?|エクセル雑感(2023-12-07)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.変数宣言のDimとデータ型|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.並べ替え(Sort)|VBA入門
8.条件分岐(IF)|VBA入門
9.セルのクリア(Clear,ClearContents)|VBA入門
10.マクロとは?VBAとは?VBAでできること|VBA入門




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


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



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