エクセルの数式から参照ブックとシートを抜き出したい

質問

あるセルが他のブックやシートを参照していたら、数式の中からブック名とシート名を抜き出したいです。
できれば、VBAを使う方法が知りたいです。（他の方法でも、あれば教えてください。）

--
・数式例１
='[Book1]Sheet4 (2)'!R[-2]C

・欲しい結果例１
ブック名＝Book1
シート名＝Sheet4 (2)

・数式例２
=Sheet1!R[-1]C

・欲しい結果例２
ブック名＝""
シート名＝Sheet1

・数式例３
=A1

・欲しい結果例３
ブック名＝""
シート名＝""

・数式例４
=IF([Book1]Sheet2!R[-3]C="",Sheet1!R[-3]C,[Book1]Sheet2!R[-3]C)

・欲しい結果例４
ブック名＝Array("Book1","","Book1")
シート名＝Array("Sheet2","sheet1","Sheet2")
--

例は単純にしましたが、実際には数式はもっと複雑で長いです。
列によって参照する場所が違い、どの列からどのブックやシートを参照しているのかを知りたくて、質問しました。

よろしくお願いいたします。

回答No.1

nishi6 · ベストアンサー

このマクロのあるブックのシート
　Sheet1、Sheet2、Sheet3、Sheet3(2)、【04】、zzz((99))

参照するブックとして、OK20191231.xlsm、そのシート
　Sht1、Sht2、Sht3、【New04】、Sht5
として作ってみました。

添付図で説明すると、A1:A8の算式を選択して実行すると、B列に算式(FormulaLocal)を表示し、C列から順に算式に使われたBook名とSheet名を表示します。
質問では、Book名とSheet名が分かれてペアのように扱われていたり(？)、「Array()」が使われていますが、２つを対応させるとマクロの行が増え、ブック間で同じシート名があると混乱しそうなので、他ブックを参照している場合は。「ブック名＋シート名」で表示しています。

算式は、FormulaR1C1Localではなく、慣れたFormulaLocalを使っています。結果はどちらを使っても同じでした。

算式は関数や演算子を多数含み、コロンやシングルクォーテーションやダブルクォーテーションも含まれるので、考慮したつもりです。半角スペースも演算子ですがテストはしていません。

またシート名に「( )」を多数含んだ場合も考慮していますが、「(」と「)」が対応していないとだめかもしれません。（未確認）
さらに、ブック名に「[ ]や( )、【 】」が多数含まれていると、どうなるかも未確認です。

確認不足の点はありますが、普通のブック名、シート名ならなんとかなるでしょう。出力方法は検討下さい。
当方Win10、Excel2010です。ご参考に。

Sub sepFormula()
　Dim rg As Range
　Dim del As Integer, chk(1) As String
　　chk(0) = "'=[,+-*/^(": chk(1) = "'=[,+-*/^"

　Dim dicSht, KeysSht, buf As String, wk As String
　Dim c As Integer, L1 As Integer, L2 As Integer
　Dim p As Integer
　Set dicSht = CreateObject("Scripting.Dictionary")

　For Each rg In Selection
　　buf = rg.FormulaLocal: rg.Offset(0, 1) = "'" & buf
　　L2 = InStrRev(buf, "!"): del = 0
　　While L2 <> 0
　　　L1 = L2 - 1
　　　　If Mid(buf, L1, 1) = "'" Then L1 = L1 - 1: del = 1
　　　p = InStr(chk(del), Mid(buf, L1, 1))
　　　While p = 0 And L1 > 0
　　　　L1 = L1 - 1: p = InStr(chk(del), Mid(buf, L1, 1))
　　　Wend

　　　'// シート名を取り出す
　　　If p > 0 Then
　　　　wk = Mid(buf, L1 + 1, L2 - L1 - 1 - del)
　　　　　If InStr(wk, "]") > 0 Then wk = "[" & wk
　　　　If Not dicSht.Exists(wk) Then
　　　　　dicSht.Add wk, wk
　　　　End If
　　　　del = 0

　　　　If L1 <> 1 Then
　　　　　L2 = InStrRev(buf, "!", L1 - 1): p = 0
　　　　Else
　　　　　L2 = 0
　　　　End If
　　　Else
　　　　L2 = 0
　　　End If
　　Wend

　　'// 逆に調べたのでディクショナリーを逆順に出力
　　KeysSht = dicSht.keys
　　For c = dicSht.Count - 1 To 0 Step -1
　　　Cells(rg.Row, dicSht.Count - c + 2) = KeysSht(c)
　　Next

　　dicSht.RemoveAll
　Next
End Sub

お礼

希望通りのものを作ってくださり、ありがとうございます！
本当に助かりました。
ベストアンサーとさせていただきます。