エクセルVBAで DirectPrecedentsプロパティ

質問

DirectPrecedentsプロパティが同一シート内しかトレースできないことを利用して、他シートを参照しているセルを判定できないかと思い、下記のマクロを書いてみました。
残念ながら他シートを参照しているセルでエラーになってしまいます。
どのよに修正すればよいでしょうか？
なお、他シート参照の判定に"！"の存在を使わないのは、「名前定義」されたセルを参照している場合を想定しているためです。

Sub TEST01()
With ActiveSheet
On Error GoTo line
For Each c In .UsedRange.SpecialCells(xlCellTypeFormulas, 23)
On Error GoTo 0
c.Select
If c.DirectPrecedents.Address = "" Then'ここでエラー
MsgBox c.Address & "は他シート参照"
Else
MsgBox c.Address & "は" & c.DirectPrecedents.Address & "参照"
End If
Next
End With
line:
MsgBox "数式がありません。"
End Sub

回答No.5

okormazd · ベストアンサー

このエラーはプログラムのエラーだから、IsError()では取れない。
IsError()は、引数を評価して、その評価の結果がエラー値かどうか判定してtrueとかfalseを返す。引数には有効な任意の式を指定する。
IsError(c.DirectPrecedents.Address)は、c.DirectPrecedents.Address
が、他シート参照のセルのAddressをとろうとしたエラーだ（有効ではない）から、評価のしようが無いということではないか。

ところで、目的は、どうしてもc.DirectPrecedents.Addresを使いたいということですか。参照のアドレスを取りたいだけなら、単にc.Formulaとすればとれるけど・・・。

お礼

ありがとうございます。

> 目的は、どうしてもc.DirectPrecedents.Addresを使いたいということですか。

いいえ、アクティブなシートに他のシートを参照しているセルがあるかどうかの判定をしたいだけです。
最初はc.Formulaに"!"があれば他のシート参照としてたのですが、それでは他シートにある名前を定義されたセルを参照した場合、シート名の！が出ないので、逆に他のシートの参照元をトレースしたらエラーになるDirectPrecedentsが使えないかと考えたのです。

回答No.6

Wendy02

こんばんは。

#4 のお礼側の件ですが、

>では、他シートを参照しているセルのDirectPrecedentsは何を返すのでしょうか？

重複しますが、プログラムとしてのエラー＝実行時エラーですね。
そうすると、コード全体がとまってしまいます。

たぶん、お分かりにはなっているとは思いますが、値自体も取れませんので、そういう場合は、

On Error Resume Next
　'実行時エラーの可能性のあるコード
　buf = Empty
　buf= c.DirectPrecedents.Address
On Error Goto 0
変数　buf は、Variant 型としたら、Empty ですが、エラーが発生すると、変数の中がクリアされませんので、前の値が残っています。だから、一旦、その変数は、Empty にしてあげないといけませんね。文字型なら、「""」 ということになります。

この件は、確かに、#5さんの　c.Formula もご指摘の通りなのですが、このマクロの発展型としては、ツールの中の[ワークシート分析]と同じことをしてもしょうがないので、数式自体を分解し、再構築して、参照先を明示するということを考えたほうがよいのかもしれません。出来る出来ないは別として。

お礼

そうか、何も返さないわけですね。
変数の使い方も大変勉強になりました。
ありがとうございました。

回答No.4

Wendy02

こんばんは。

>たとえば、IsError(c.DirectPrecedents.Address)　
それ自体に、エラーを吐くわけではありません。
例えば、Application.Sum(...) というのは、エラー値を返すような仕組みが出来ていますが、c.DirectPrecedents.Address 自身の内部でエラーが起きるので、IsError では囲えません。エラー値は、一つの型の値なのです。

それと、#3のコードは今回の質問内容とは違うコードでしたので、もう少し言い訳させていただきたいのですが、この件に関しては、過去2度行っていて、昨年だったと思いますが、数式の参照先にジャンプでそこに飛ぶというものだったので、その記憶が強く残っていました。改めて訂正させていただきます。

お礼

＞#3のコードは今回の質問内容とは違うコードでしたので、

今回のわたしの質問と直接の関係はないですが、すばらしいユーザー定義関数です。勉強させていただきます。ありがとうございました。

>> たとえば、IsError(c.DirectPrecedents.Address)　
> それ自体に、エラーを吐くわけではありません。

では、他シートを参照しているセルのDirectPrecedentsは何を返すのでしょうか？
"" でも　Nothing　でもないようです。どうやったらしらべられるのでしょうか？

回答No.3

Wendy02

#2 のことわりを入れておきますが、

#2のコードのユーザー定義のアドレスの切り分けは、そのままでは、まったく意味がありません。取れたアドレスは、そのまま、表示すればよいだけのことです。ただ、それをVBAで再利用するときにだけ、「[ブック名]シート名! セル座標」の切り分けが必要になるというものです。

だから、そのユーザー定義関数は、今回の内容からすれば無意味です。

お礼

Wendy02さま、いつもありがとうございます。

Sub TEST03()
Dim c As Range
Dim buf As Variant
With ActiveSheet
On Error GoTo line
For Each c In .UsedRange.SpecialCells(xlCellTypeFormulas, 23)
On Error GoTo 0
On Error Resume Next
buf = Empty
buf = c.DirectPrecedents.Address
On Error GoTo 0
If IsEmpty(buf) Then
MsgBox c.Address & "は他シート参照"
Else
MsgBox c.Address & "は" & c.DirectPrecedents.Address & "参照"
End If
Next
End With
Exit Sub
line:
MsgBox "数式がありません。"
End Sub

いったんBufに取り込むようにしたことでできました。
ただ、たとえば、IsError(c.DirectPrecedents.Address)　というような感じでなぜエラーを判定できないのが腑に落ちないのです。

回答No.2

Wendy02

こんにちは。

うーん、今の状態では、基本的に無理があるかなって思います。
私の作ったものでも、名前定義とか関係なく、数式が複合的になると、うまくいきません。数式を切り分けする必要があるようです。

'-------------------------------------------
Sub FindReferencesMacro()
'DirectPrecednts を使ったマクロ
　　Dim c As Variant
　　Dim buf As Variant
　　Dim pAddr As String

　　With ActiveSheet
　　　　On Error GoTo ErrHandler
　　　　For Each c In .UsedRange.SpecialCells(xlCellTypeFormulas, 23)
　　　　　　On Error Resume Next
　　　　　　buf = Empty
　　　　　　buf = c.DirectPrecedents.Address
　　　　　　On Error GoTo 0
　　　　　　If IsEmpty(buf) Then
　　　　　　　　FindPrecedent c.FormulaLocal, pAddr
　　　　　　Else
　　　　　　　　pAddr = c.DirectPrecedents.Address
　　　　　　End If
　　　　　　MsgBox c.Address & " は " & pAddr & " を参照"
　　　　　　pAddr = ""
　　　　Next
　　End With
　　Exit Sub
ErrHandler:
　　MsgBox Err.Number & ": " & Err.Description
End Sub
Function FindPrecedent(ByVal strForml As String, ByRef strAdd As String)
　　Dim Matches As Object
　　Dim Match As Object
　　Dim w As String, s As String, c As String
　　If Not strForml Like "=?*" Then Exit Function
　　If InStr(strForml, "!") > 0 Then
　　　　With CreateObject("VBScript.RegExp")
　　　　　　.Pattern = "=(\[.*\])?(.*)\!(.*)"
　　　　　　.Global = True
　　　　　　Set Matches = .Execute(strForml)
　　　　　　If Not Matches Is Nothing Then
　　　　　　　　On Error Resume Next
　　　　　　　　w = Matches(0).SubMatches(0)
　　　　　　　　s = Matches(0).SubMatches(1)
　　　　　　　　c = Matches(0).SubMatches(2)
　　　　　　　　On Error GoTo 0
　　　　　　End If
　　　　End With
　　Else
　　　　FindPrecedent Application.Names(Mid$(strForml, 2)), strAdd
　　End If
　　If strAdd = "" Then
　　　　strAdd = w & s & "!" & c
　　End If
End Function

'-------------------------------------------

回答No.1

okormazd

基本的には直っていないだろうが、目的の動作はするけど。
こういう姑息なことではない？
アクティブ シートでしかできないといっているのを使うのだからこうなっても・・・。

Sub TEST01()
With ActiveSheet
On Error GoTo line
For Each c In .UsedRange.SpecialCells(xlCellTypeFormulas, 23)
'On Error GoTo 0
c.Select
Debug.Print Selection.Row, Selection.Column
'Debug.Print c.DirectPrecedents.Address

If c.DirectPrecedents.Address = "" Then 'ここでエラー
'MsgBox c.Address & "は他シート参照"
Else
MsgBox c.Address & "は" & c.DirectPrecedents.Address & "参照"
End If
Next
End With

Exit Sub

line:
MsgBox c.Address & "は他シート参照"
Resume Next

End Sub

お礼

ありがとうございます。
姑息だなんてとんでもない。エラーハンドラーからResume NextでまたFor Nextの続きに戻れるとは知りませんでした。
ということはこれでいけますね。↓

Sub TEST02()

With ActiveSheet
On Error GoTo line1
For Each c In .UsedRange.SpecialCells(xlCellTypeFormulas, 23)

On Error GoTo line2
MsgBox c.Address & "は" & c.DirectPrecedents.Address & "参照"
Next
End With

Exit Sub

line1:
MsgBox "数式がありません。"
Exit Sub

line2:
MsgBox c.Address & "は他シート参照"
Resume Next

End Sub

ただ、たとえば、IsError(c.DirectPrecedents.Address)　というような感じでなぜエラーを判定できないのが腑に落ちないのです。