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


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 ・・・新着記事一覧を見る

エクセル試験3:月間の所定労働時間|エクセル練習問題(2023-10-04)
エクセル試験2:所得税の計算|エクセル練習問題(2023-10-04)
エクセル試験1:曜日別の平均客単価|エクセル練習問題(2023-10-04)
列全体を指定する時のRangeとColumnsの違い|ツイッター出題回答 (2023-09-24)
シートのActiveXチェックボックスの指定方法|ツイッター出題回答 (2023-09-24)
ByRef引数の型が一致しません。|ツイッター出題回答 (2023-09-22)
シートコピー後のアクティブシートは何か|ツイッター出題回答 (2023-09-19)
Excel関数の引数を省略した場合について|ツイッター出題回答 (2023-09-14)
セル個数を返すRange.CountLargeプロパティとは|VBA技術解説(2023-09-08)
記号を繰り返してグラフ作成(10単位で折り返す)|ツイッター出題回答 (2023-08-28)


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

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




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


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



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