エクセルで数式の中のセル番地を取り出す方法？

質問

エクセル2000です。
C列で
=Sheet1!B17とか
=Sheet2!C13というように他のシートのセルを参照しています。
これをA列にシート名（Sheet1）、B列にセル番地（B17）を取り出す方法はないでしょうか？
なお、実際のシート名はSheet1～Nではなく、不定です。

回答No.1

noname#123709 · ベストアンサー

VBAですが。
Sub test()
Dim i As Long
For i = 1 To Range("C65536").End(xlUp).Row
Cells(i, 1).Value = Left(Cells(i, 3).Formula, InStr(Cells(i, 3).Formula, "!") - 1)
Cells(i, 1).Value = Right(Cells(i, 1).Formula, Len(Cells(i, 1).Formula) - 1)
Cells(i, 2).Value = Right(Cells(i, 3).Formula, Len(Cells(i, 3).Formula) - InStr(Cells(i, 3).Formula, "!"))
Next i
End Sub

お礼

Formulaを使えばよかったんですね！
期待の結果が得られました。有難うございました。

回答No.9

Wendy02

こんにちは。Wendy02です。

＞これはどうやって使うのでしょうか？
標準モジュールに登録したら、

A1:式があるとすれば、
　=IF(Sheet1!B17="","",Sheet1!B17)

B1:
=BPRC(A1)
として、単に、"B17" が返ってきます。ただ、それだけの話です。しかし、名前定義を使っても、同じように返ってきます。この場合は、同じところに参照しているので、B17 ですが、もし、二つにすれば、二つのセル番地が返ります。

お礼

ありがとうございました。
なんどもすみません。

回答No.8

Wendy02

merlionXX さん、少し、がんばってみました。

まず、関数名が長たらしいので、省略してみました。
丁寧に作り上げたつもりではいるのですが、まだ、ヘンなところが残っているかもしれません。一通り、いろんな複雑な式を含めて代入してみました。R1C1方式でも、A1方式でも使用可能です。R1C1方式の場合は、絶対参照で、A1方式では、相対参照で出力します。同じブック内なら、ブック名は出ませんが、違うブック名では、ブック名が表示されます。

＞Functionというのを使うやり方にも興味がありますので
本来は、C言語で作ったほうが良いらしいのですが、私は良く知りません。VB でも作れるのですが、こちらは、あまり勝手が良くありません。Function は、良く出来たものなら、アドイン化してもよいのですが、臨時的なものは、標準モジュールです。なお、「値渡し」にする必要は、ワークシート用の場合は、ないと思います。

'-------------------------------------------------------------
Function BPRC(rng As Range) As String
'参照先のセルのアドレスを出すユーザー定義関数
　 Dim objRe As Object
　 Dim buf As String, buf1 As String, buf2 As String, buf3 As String
　 Dim buf4 As String, bufnm As String, bufsh As String, bufwb As String
　 Dim bufar As Variant
　 Dim wb As Workbook, sh As Worksheet
　 Dim nm As Variant
　 Dim ar() As String
　 Dim n As Integer, m As Integer
　 Dim Matches As Object, Match As Object

　 '正規表現オブジェクト
　 Set objRe = CreateObject("VBScript.RegExp")

　 With rng
　 If .HasFormula = False Then Exit Function
　　　If Application.ReferenceStyle = xlR1C1 Then
　　　　 buf1 = Application.ConvertFormula(.FormulaR1C1, xlR1C1, xlA1, xlRelative, .Cells)
　　　　 Else
　　　　 buf1 = Application.ConvertFormula(.FormulaLocal, xlA1, xlA1, xlRelative, .Cells)
　　　End If
　 End With
　 For Each nm In Application.Names
　　　If InStr(buf1, nm.Name) > 0 Then
　　　　 bufnm = nm.Name
　　　　 buf = nm.RefersTo
　　　　 buf = Mid$(buf, 2)
　　　　 ReDim Preserve ar(n)
　　　　 ar(n) = bufnm & "=" & buf
　　　　 n = n + 1
　　　　 buf1 = Replace$(buf1, bufnm, "")
　　　End If
　 Next nm
　 objRe.Global = True
　 objRe.Pattern = "!([^\!\*\+\-\/\=):,]+)"

　 For Each wb In Workbooks
　　　If InStr(buf1, "[" & wb.Name & "]") > 0 Then
　　　　 bufwb = "[" & wb.Name & "]"
　　　　 buf2 = Replace(buf1, bufwb, "", , 1)
　　　　 If Application.ReferenceStyle = xlR1C1 Then
　　　　　 buf2 = Replace$(buf2, "'", "")
　　　　 End If
　　　　 Do
　　　　　　For Each sh In wb.Sheets
　　　　　　　 If InStr(buf2, sh.Name) > 0 Then
　　　　　　　　　buf3 = Replace(buf2, sh.Name, "", , 1)
　　　　　　　　　bufsh = sh.Name

　　　　　　　　　Set Matches = objRe.Execute(buf3)
　　　　　　　　　buf4 = objRe.Replace(Matches(0).Value, "$1")
　　　　　　　　　ReDim Preserve ar(n)
　　　　　　　　　If bufwb Like "*" & ThisWorkbook.Name & "*" Then
　　　　　　　　　　 ar(n) = sh.Name & "!" & Range(buf4).Address(0, 0)
　　　　　　　　　　 buf2 = Replace$(buf2, ar(n - 1), "")
　　　　　　　　　Else
　　　　　　　　　　 ar(n) = bufwb & sh.Name & "!" & Range(buf4).Address(0, 0)
　　　　　　　　　　 buf2 = Replace$(buf2, sh.Name & "!" & Range(buf4).Address(0, 0), "")
　　　　　　　　　End If
　　　　　　　　　n = n + 1

　　　　　　　　　If objRe.test(buf2) = False Then Exit Do
　　　　　　　 End If
　　　　　　Next sh
　　　　 Loop While objRe.test(buf2)
　　　End If
　 Next wb
　 If buf2 = "" Then buf2 = buf1
　 If Application.ReferenceStyle = xlR1C1 Then
　　　　　 buf2 = Replace$(buf2, "'", "")
　 End If
　 For m = 1 To 2
　　　If m = 1 Then
　　　　 objRe.Pattern = "[\*\+\-\/\=\(,:]([A-Z]{1,2}\d+)"
　　　　 objRe.Global = True
　　　　 Else
　　　　 objRe.Pattern = "([A-D0-9]{1,3}:[A-D0-9]{1,3})"
　　　　 objRe.Global = True
　　　End If
　　　If objRe.test(buf2) Then
　　　　 Set Matches = objRe.Execute(buf2)
　　　　 For Each Match In Matches
　　　　　　ReDim Preserve ar(n)
　　　　　　buf4 = objRe.Replace(Match.Value, "$1")
　　　　　　'旧バージョン仕様
　　　　　　bufar = Application.Match(buf4, ar(), 0)
　　　　　　If IsError(bufar) Then
　　　　　　　 ar(n) = buf4
　　　　　　　 n = n + 1
　　　　　　End If
　　　　 Next
　　　　 ReDim Preserve ar(n - 1)
　　　End If
　 Next m
　 If Application.ReferenceStyle = xlR1C1 Then
　　　bufar = Application.ConvertFormula(Join(ar(), ","), xlA1, xlR1C1, xlAbsolute)
　　　BPRC = Replace$(bufar, "[" & ThisWorkbook.Name & "]", "")
　 Else
　　　BPRC = Join(ar(), ",")
　 End If
　 Set objRe = Nothing
End Function

お礼

ありがとうございます。
で、これはどうやって使うのでしょうか？このままではわたしには宝の持ち腐れになってしまいそうです。

回答No.7

Wendy02

こんにちは。Wendy02です。

すみません、今、見直しましたが、1行・2行直すレベルではありませんでした。中身を全部換えます。絶対参照と相対参照の違いがあったりして、そう簡単にはいきませんでした。考え方自体が間違えだったようです。

再度、私の勉強のためにやり直してみます。メインの質問と外れるかもしれませんが、よろしかったら、長い目でみてやってください。お願いします。

お礼

「すみません」だなんてとんでもない！
いつも助けてもらってばかりで、謝るのは私の方です。

今回は、No1さんのを変形して使わせていただいて、
Sub TEST01()
For i = 1 To Range("C65536").End(xlUp).Row
Cells(i, 1).Value = Mid(Cells(i, 3).Formula, 5) '=IF(を消す
Cells(i, 1).Value = Left(Cells(i, 1).Value, InStr(Cells(i, 1), "=") - 1) '=の前だけ
Cells(i, 2).Value = Mid(Cells(i, 1).Value, InStr(Cells(i, 1), "!") + 1) 'セル名だけ
Cells(i, 1).Value = Left(Cells(i, 1).Value, InStr(Cells(i, 1), "!") - 1) '!の前だけ
Next i
End Sub
でうまく行きました。

ただ、Functionというのを使うやり方にも興味がありますので、それではまだ締め切らないでおきます。いつも有難うございます。

回答No.6

Wendy02

こんばんは。Wendy02です。

ちょっと、あまり格好が良くありませんが、何とか、出せるようにしてみました。(2年ぐらい前のレベルのコードになってしまいました。（^^;）

式の名前の、Beyond Precedents は、Precedents というメソッドが、本来の機能を持っているのですが、ワークシートを越えて出来ませんので、このような名前にしました。
ただし、現在のバージョンでは、ブック間は出来ません。

Function BydPreCedents(rng As Range)
　 Dim ar() As String, buf1 As String, buf2 As String, buf3 As String, buf4 As String
　 Dim i As Long, j As Integer, k As Integer
　 Dim sh As Worksheet
　 With rng
　　　If .HasFormula Then
　　　　 buf1 = .FormulaR1C1
　　　　 Do
　　　　　　For Each sh In Worksheets
　　　　　　　 i = InStr(buf1, sh.Name)
　　　　　　　 If i = 0 Then
　　　　　　　　　i = InStr(buf1, "R[")
　　　　　　　 End If
　　　　　　　 j = InStr(InStr(buf1, "C["), buf1, "]")
　　　　　　　 buf2 = Mid(buf1, i, j - i + 1)

　　　　　　　 ReDim Preserve ar(k)

　　　　　　　 If Application.ReferenceStyle = xlA1 Then
　　　　　　　　　buf3 = Application.ConvertFormula(buf2, xlR1C1, xlA1)
　　　　　　　 End If
　　　　　　　 buf4 = Mid$(buf3, InStr(buf3, "]") + 1)
　　　　　　　 ar(k) = buf4
　　　　　　　 k = k + 1
　　　　　　　 Exit For
　　　　　　Next
　　　　　　buf1 = Replace$(buf1, buf2, "")
　　　　 Loop Until InStrRev(buf1, "]") = 0
　　　End If
　 End With
　 BydPreCedents = Join(ar(), ",")
End Function

お礼

ありがとうございます。
ブックをこえて使用はしません。

ただ、Functionというのはあまり使ったことがなく、このFunction BydPreCedents(rng As Range)から、参照シート名やセルを取り出す方法がよく分からないのです。
ためしに
Sub test()
MsgBox BydPreCedents(ActiveCell)
End Sub
としたら、Sheet1!B17はでましたが、ワークシートに=BydPreCedents(C11)としたら、違うセル名になってしまいました。（泣）

回答No.5

Wendy02

こんにちは。

> =IF(Sheet1!B17="","",Sheet1!B17)とか

になったら、もう、ユーザー定義関数のほうが確実かもしれませんね。今、Ver4 マクロ関数で作って、出来ないことはないけれども、複雑なものになれば、とても、面倒な内容になってしまいます。

回答No.4

Wendy02

こんにちは。Wendy02です。

一応、Excel 2000 では、マクロの領域に入らない方法を披露しておきます。VBAのユーザー定義関数という手もありますでしょうが、もう少し平易な方法です。

マクロ関数 Ver.4: 　GET.CELL(6, 範囲)
(範囲 に入力されている数式を、その時点で設定されている参照形式を使った文字列で返します。)

時々、将来が使えなくなる、とかいう方もいらっしゃいますが、私は、Microsoft の内部情報など知りませんし、まして、現Versionで使えるものに対して、他人に使うな、という人の書き込みは、私は、少々、呆れています。

手順:

まず、C列に式があるとしたら、セルポインターを同じ行のA列に持ってきておいて、

メニュー－[挿入]－[名前]－[定義]

名前(W)
　SIKI

参照範囲(R)
=GET.CELL(6,Sheet1!$C1)&LEFT(NOW(),0)

とします。$C1 の行の部分は、相対参照にします。

A列の同じ行に、
=MID(SIKI,2,FIND("!",SIKI)-2)

B列の同じ行に、
=MID(SIKI,FIND("!",SIKI)+1,20)　　'←最後の20は任意

注意:なお、この式は、同じシート内でしか使用できません。絶対に、コピーして、他のシート、他のブックに貼り付けるようなことはしてはいけません。

また、シート名が入らないことも考慮すれば、
A列:
=IF(ISERROR(FIND("!",SIKI)),"",MID(SIKI,2,FIND("!",SIKI)-2))
B列:
=IF(ISERROR(FIND("!",SIKI)),MID(SIKI,2,20),MID(SIKI,FIND("!",SIKI)+1,20))

お礼

お礼が遅くなってしまい申し訳ありません。
有難うございます。こんな方法があるんですね？！おどろきです。
ただ、残念ながらもとの式が
=Sheet1!B17ではなく
=IF(Sheet1!B17="","",Sheet1!B17)とか
=IF(Sheet15!B170="","",Sheet15!B170)のように変わってしまい、使えなくなってしまいました。（泣）

回答No.3

Ryokucha

シート名は
=RIGHT(CELL("filename",Sheet1!B17),LEN(CELL("filename",Sheet1!B17))-FIND("]",CELL("filename",Sheet1!B17)))
で出てくるはずです。

セル番地は
=CELL("address",Sheet1!B17)
で判ることは判るのですが、
ご質問の答えに余分なものがついてしまいます。
頑張れば抽出できそうですが、大変そう^_^;

ご参考にして下さい。

お礼

ありがとうございます。
残念ながら意図することとは違うようです。

回答No.2

mu2011

次の方法は如何でしょうか。期待値と相違していましたら読み飛ばして下さい。
１．Ｃ列を選択
２．データ→区切り位置
３．「カンマやタブなど・・・」を選択→次へ
４．区切り文字→その他を選択し、「！」入力→次へ
５．各列データ形式を文字列
６．表示先を＄Ａ＄１→完了
因みにＡ列のシート名に「＝」が残りますので、不要なら置換して下さい。

お礼

なんと！
VBAじゃなくともこんなやり方があったんですね！！しかも早い！！
VBAで１分かかったのが瞬時でできちゃいました。おどろいたあ。
有難うございました。

補足

A列がみんなエラー値になってあせりましたが、＝を削除したら文字列になりました。良かった。