Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 7 Professional : Excel 2013)
数式からシート名を取得したい
投稿日時: 18/06/27 20:15:32
投稿者: kyu92

他社の方が作成したマクロを引き継ぎましたが、
数式にて他のシートを参照しているのかを調査しようとしています。
シート数が100以上あり一つ一つ調べるのは膨大な時間を必要とするため
VBAを組もうと試みました。
 
他のシートを参照するセルは、"!"があるかどうかで判定できるのですが、
シート名をうまく取得できません。
●●●●でシート名を数式からカットして変数へ格納したいのですが、
うまくできません。簡単には取得できないのでしょうか。
 
記述した数式も複雑で1つの数式内に複数のシートを参照している場合もあります。
 
For Each ws In wb.Worksheets
    ws_list.Cells(i,1).valuie = ws.Name
    On Error Resume Next
    Set rng = ws.Cells.Find(what:="!",LookIn:=xlFormulas,LookAt:=xlPart)
    On Error Goto 0
    If rng Is Nothing then
  ws_list.Cells(i,2).valuie = "None"
    Else
   ws_list.Cells(i,2).valuie = "Exist"
        Set rFirstCell = rng
        Do
            Set rng = ws.Cells.FindNext(rng)
            ●●●●
        Loop while rng.Address <> rFirstCell.Address
   end if
Next ws
 
有識者の皆様どうぞよろしくお願いいたします。

回答
投稿日時: 18/06/27 23:05:23
投稿者: simple

定義された[名前]を数式中で使っていたら、いくらFormulaを分析しても参照元を得ることは
できないと思いますが、そのあたりはどうですか?
  
なお、機械的に参照先を求めることは可能だとは思います。
ただし、結局のところシートで何をやっているかの理解が必要であり、
その作業そのものを代替することはできないと思います。
理解にあたって、他シート参照だけが障害になっているとも思えません。
やはりシートを読み込んで行くほか無いと思います。
  
なぜ他シート参照がポイントとお考えなのか、説明いただけませんか?
 
# 変数の定義もないし、.valuie とか、ちょっと手抜きですか?

回答
投稿日時: 18/06/27 23:14:22
投稿者: 半平太

アイデアだけですけど、
 
シート名を変更すると、数式も追随して変わります。その機能を利用して・・
 
左から順番に、シート名+"ZWR001" 、+ZWR002、・・、+ZWR100 に変えてみる。
 
すると、他のシートを参照する数式は「・・ZWRxxx!」なる文字を含むハズである。
 
例えば、"!" より左の6文字に「ZWR021」があったら、左から21番目のシートを参照している数式と判明する。
 
全て調べ終わったら、元のシート名に戻す(つまり、右6文字を削除する)

回答
投稿日時: 18/06/27 23:43:15
投稿者: WinArrow
投稿者のウェブサイトに移動

参考意見
 
私のフリーソフト「見セル」(アドインソフト)の中で、
「参照元Ex]というプロシジャがあります。
この機能は、セルに入力してある数式を文字列として扱い、
数式を分解して「他シート」「他ブック」を参照している情報を抽出するものです。
 
10年位前に作製したソフトで、今となっては、解析しないと確かなことは言えませんが、
数式文字列を分解するに当たって、
演算文字(+,-,*,/,(,),など)をTABに置換、SPLITで分割しています。
中には、定義した名前も存在するので、「名前」なのか、単なるリテラルなのかを判断しています。
(名前リストを参照すれば、判断できます)
 
ほんのさわりだけのヒントですが、参考になれば、トライしてみてください。
 
 
 
 

投稿日時: 18/06/28 06:49:55
投稿者: kyu92

simple さんの引用:
定義された[名前]を数式中で使っていたら、いくらFormulaを分析しても参照元を得ることは
できないと思いますが、そのあたりはどうですか?
  
なお、機械的に参照先を求めることは可能だとは思います。
ただし、結局のところシートで何をやっているかの理解が必要であり、
その作業そのものを代替することはできないと思います。
理解にあたって、他シート参照だけが障害になっているとも思えません。
やはりシートを読み込んで行くほか無いと思います。
  
なぜ他シート参照がポイントとお考えなのか、説明いただけませんか?
 
# 変数の定義もないし、.valuie とか、ちょっと手抜きですか?

 
名前定義は確かにこの処理では得ることはできませんが、
別途各シートの使用する名前定義の一覧を作成する予定です。
 
なぜ他シート参照がポイントなのか申しますと、
シート関数で処理しているものをVBAで実行するように改修中です。
VBAで実行するために、他シート参照によってどのような順番で実行するかを
制御する必要があるためです。
 
変数定義は割愛してしまいました。
コピーできない環境で作業しているため入力ミスです。
失礼いたしました。

投稿日時: 18/06/28 06:54:13
投稿者: kyu92

半平太 さんの引用:
アイデアだけですけど、
 
シート名を変更すると、数式も追随して変わります。その機能を利用して・・
 
左から順番に、シート名+"ZWR001" 、+ZWR002、・・、+ZWR100 に変えてみる。
 
すると、他のシートを参照する数式は「・・ZWRxxx!」なる文字を含むハズである。
 
例えば、"!" より左の6文字に「ZWR021」があったら、左から21番目のシートを参照している数式と判明する。
 
全て調べ終わったら、元のシート名に戻す(つまり、右6文字を削除する)

 
アイデアありがとうございます。
一度試してみようと思います。

投稿日時: 18/06/28 07:00:21
投稿者: kyu92

WinArrow さんの引用:
参考意見
 
私のフリーソフト「見セル」(アドインソフト)の中で、
「参照元Ex]というプロシジャがあります。
この機能は、セルに入力してある数式を文字列として扱い、
数式を分解して「他シート」「他ブック」を参照している情報を抽出するものです。
 
10年位前に作製したソフトで、今となっては、解析しないと確かなことは言えませんが、
数式文字列を分解するに当たって、
演算文字(+,-,*,/,(,),など)をTABに置換、SPLITで分割しています。
中には、定義した名前も存在するので、「名前」なのか、単なるリテラルなのかを判断しています。
(名前リストを参照すれば、判断できます)
 
ほんのさわりだけのヒントですが、参考になれば、トライしてみてください。
 

 
参考意見ありがとうございます。
処理時間を要するかもしれませんが、
確かにこの考えで処理できそうですね。
トライしてみようと思います。

回答
投稿日時: 18/06/28 20:57:47
投稿者: simple

正規表現で書いてみました。
  
単に、別のシートを参照しているセルと、その別シートを列挙するというものです。
  
(1)正規表現の言語境界\bというのを使ってみましたが、
   日本語の場合のふるまいを実は詳細に理解していないので、空振りに終わる可能性があります。
(2)出力先の変更とか、多数のシートに拡張するところなどはそちらで対応してください。
 参考にして下さい。
  
なお、「名前」には対応していません。
(あとで時間があれば、「名前」にも対応した別の方法も提案したいと思います。)
 

Option Explicit

Dim re As Object
Sub test()
    Dim dic     As Object
    Dim ws      As Worksheet
    Dim s       As String
    Dim r       As Range
    Dim mySheets As Variant
    Dim j       As Long
    
    '正規表現の設定
    Set re = CreateObject("VBScript.RegExp")
    Set dic = CreateObject("Scripting.Dictionary")
    For Each ws In ThisWorkbook.Worksheets
        dic(ws.Name) = Empty
    Next
    s = Join(dic.keys, "|")
    With re
      .Global = True
      .Pattern = "\b(" & s & ")!"
    End With
    
    For Each r In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas, 23)
        
        'セルrの参照元が他シートであるものを配列で受け取る
        mySheets = getPrecedentSheets2(r.Formula)

        'イミディエイトにデバッグ出力
        On Error Resume Next
        For j = 1 To UBound(mySheets)
            Debug.Print deleteBookName(r.Address(external:=True)) & " <== " & mySheets(j)
        Next
        On Error GoTo 0
    Next
End Sub

Function getPrecedentSheets2(s As String) As Variant
    Dim mat()   As String
    Dim mCount  As Long
    Dim matches As Object
    Dim k       As Long
    
    Set matches = re.Execute(s)  '検索の実行
    mCount = matches.Count

    If mCount > 0 Then
        ReDim mat(1 To mCount)
        For k = 1 To mCount
            mat(k) = matches(k - 1).SubMatches(0)
        Next
    End If
    getPrecedentSheets2 = mat
End Function

投稿日時: 18/06/29 07:48:52
投稿者: kyu92

simple さんの引用:
正規表現で書いてみました。
  
単に、別のシートを参照しているセルと、その別シートを列挙するというものです。
  
(1)正規表現の言語境界\bというのを使ってみましたが、
   日本語の場合のふるまいを実は詳細に理解していないので、空振りに終わる可能性があります。
(2)出力先の変更とか、多数のシートに拡張するところなどはそちらで対応してください。
 参考にして下さい。
  
なお、「名前」には対応していません。
(あとで時間があれば、「名前」にも対応した別の方法も提案したいと思います。)
 

 
コードまで回答いただきありがとうござます。
正規表現はアイデアにはなかったですね。
一度試してみようと思います。
 

回答
投稿日時: 18/06/30 09:22:11
投稿者: simple

前の発言で、プロシージャをひとつ載せ忘れました。失礼しました。

Function deleteBookName(s As String) As String
    deleteBookName = Mid(s, InStr(s, "]") + 1)
End Function
# 想像されたとおりでしょうけど。

回答
投稿日時: 18/06/30 09:39:23
投稿者: simple

名前定義も含めて対応する案です。
 
■他シート参照を含む数式を含むセルを選択して、
「数式」の「ワークシート分析」にある「参照元トレース」を実行すると、
他シートアイコンに向けた点線の→が表示されます。
 
この点線をダブルクリックすると、参照元を選択画面が表示されます。
この「移動先」を順次取得すれば、求めることができます。
「名前」が数式中で使われていても、実際の参照に読み替えて動作します。
 
■これをマクロで実現するのが、Range.NavigateArrow メソッドです。
実在する「移動先」の個数を予めメソッドやプロパティで取得することが
できなかったので、LinkNumber引数を順次増やしていって、エラーになるまで
実行しています。
 
■NavigateArrowメソッドは、
(1)他シート参照、自シート参照の順に発生するようです。
(2)他シート参照、自シート参照が混在しているときは、
   繰り返し変数k が 「移動先」個数を超えた時にエラーが起きて、
   Exit Do することでよい。(その後に自シートの参照元を見る必要はない。)
(3)自シート参照のみの場合は、
   参照元が自シートと異なる場合にのみ情報を取得するようにしているので、
       If referCell.Parent.Name <> r.Parent.Name Then)。
   自シート参照を除外することができます。
 
■時間的にはかなり低速だと思います。(画面更新の抑止は必須です)
今回ケースで耐えうるものになるか保証はありません。
 
では、参考コードを載せます。
----------------------------------------------

Option Explicit

'他シート参照しているセルについて
' "Sheet1!A1 <== Sheet2!A2" のような形式で参照情報を作成する。
'結果は、予め作成した"toolsheet"に書き込む(■シート名は要カスタマイズ)

Dim mat() As String '結果保存用配列
Dim p As Long       'そのindex

Sub testByNavigateArrow()
    Dim ws      As Worksheet
    Dim myRange As Range
    Dim r       As Range
    Dim j       As Long

    Dim t
    t = Timer

    Application.ScreenUpdating = False  'これは必須です。(スピードが断然違う)

    p = 0
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "toolsheet" Then
            On Error Resume Next
            Set myRange = ws.UsedRange.SpecialCells(xlCellTypeFormulas, 23)
            If Not Err.Number = 0 Then
                For Each r In myRange
                    'セルrの参照元が他シートであるものを
                    '配列matに書き込む(NavigateArrowを利用)
                    Call getPrecedents(r)
                Next
            End If
        End If
    Next
    
    Worksheets("toolsheet").UsedRange.ClearContents
    Worksheets("toolsheet").[A1].Resize(UBound(mat) + 1, 1).Value _
              = Application.Transpose(mat)

    Debug.Print Timer - t
End Sub

Function getPrecedents(r As Range)
    Dim referCell As Range
    Dim k As Long
    Dim j As Long
    Dim s As String

    r.Parent.ClearArrows
    r.ShowPrecedents    '参照元

    k = 0
    On Error Resume Next
    Do
        k = k + 1
        '指定されたセル範囲のトレース矢印をたどって、
        '参照元(k番目)を返す。
        Set referCell = r.NavigateArrow(TowardPrecedent:=True, _
                                        ArrowNumber:=1, LinkNumber:=k)
        If Err.Number = 0 Then
            If referCell.Parent.Name <> r.Parent.Name Then '他シートの参照なら
                p = p + 1
                ReDim Preserve mat(p - 1)
                mat(p - 1) = myAddress(r) & " <== " & myAddress(referCell)
            Else
                Exit Do
            End If
        Else
            Exit Do
        End If
     Loop
    On Error GoTo 0
    r.Parent.ClearArrows
End Function

Function myAddress(r As Range) As String
    Dim s As String
    s = r.Address(RowAbsolute:=False, ColumnAbsolute:=False, external:=True)
    s = Replace(s, "'", "")
    myAddress = Mid(s, InStr(s, "]") + 1)
End Function

# これは結構変態的コードなので、質問掲示板でも余り見ません。
# ひとつだけ検索にかかりましたが、ほぼ同時刻のコードが手元にあったので、
# たぶん私なんでしょう。記憶は無いけれど。

投稿日時: 18/07/01 09:31:21
投稿者: kyu92

simple さんの引用:
前の発言で、プロシージャをひとつ載せ忘れました。失礼しました。
Function deleteBookName(s As String) As String
    deleteBookName = Mid(s, InStr(s, "]") + 1)
End Function
# 想像されたとおりでしょうけど。

 
ありがとうございます!
前の回答のコードを参考にして参照シートのリストを作成できました。
名前定義も含めてのコードもあるがとうございます。
少し複雑ですが一度試してみようと思います。

トピックに返信