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

Question

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

okormazd · Accepted Answer

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

Wendy02 · Answer

こんばんは。

#4 のお礼側の件ですが、

>では、他シートを参照しているセルのDirectPrecedentsは何を返すのでしょうか？

重複しますが、プログラムとしてのエラー＝実行時エラーですね。
そうすると、コード全体がとまってしまいます。

たぶん、お分かりにはなっているとは思いますが、値自体も取れませんので、そういう場合は、

On Error Resume Next
　'実行時エラーの可能性のあるコード
　buf = Empty
　buf= c.DirectPrecedents.Address
On Error Goto 0
変数　buf は、Variant 型としたら、Empty ですが、エラーが発生すると、変数の中がクリアされませんので、前の値が残っています。だから、一旦、その変数は、Empty にしてあげないといけませんね。文字型なら、「""」 ということになります。

この件は、確かに、#5さんの　c.Formula もご指摘の通りなのですが、このマクロの発展型としては、ツールの中の[ワークシート分析]と同じことをしてもしょうがないので、数式自体を分解し、再構築して、参照先を明示するということを考えたほうがよいのかもしれません。出来る出来ないは別として。

Wendy02 · Answer

こんばんは。

>たとえば、IsError(c.DirectPrecedents.Address)　
それ自体に、エラーを吐くわけではありません。
例えば、Application.Sum(...) というのは、エラー値を返すような仕組みが出来ていますが、c.DirectPrecedents.Address 自身の内部でエラーが起きるので、IsError では囲えません。エラー値は、一つの型の値なのです。

それと、#3のコードは今回の質問内容とは違うコードでしたので、もう少し言い訳させていただきたいのですが、この件に関しては、過去2度行っていて、昨年だったと思いますが、数式の参照先にジャンプでそこに飛ぶというものだったので、その記憶が強く残っていました。改めて訂正させていただきます。

Wendy02 · Answer

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

Wendy02 · Answer

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

okormazd · Answer

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

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

このエラーはプログラムのエラーだから、IsError()では取れない。

こんばんは。

こんばんは。

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

こんにちは。

基本的には直っていないだろうが、目的の動作はするけど。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

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