VBAからのHYPERLINK関数のアドレス取得法

質問

いつもお世話になっています。Excel 2003のVBAについてご質問させてください。

あるセル上に、下記のように別名が指定されたHYPERLINK関数があります。

=HYPERLINK(配置先, ファイル名)

現在、VBAよりHYPERLINK関数が指し示す配置先（アドレス）を取得しようと思っています。
これを取得するにはどうすれば良いでしょうか？

なお、以下のような付加条件があります。かなりワガママだとは自覚していますが、
なにとぞお知恵をお貸しください。
(1)「配置先」には、実際には複雑な分岐等があり、これを生成するロジックのVBA化は困難
(2)「配置先」だけ別セルに書き出すことは出来なくはないが、今回は避けたい
(3)Excel 2010でも動作する必要がある。

(3)についてはこちらで動作確認致しますので、Excel 2003での情報をお願いします。

回答No.2

mt2008 · ベストアンサー

かなり強引だけどこんなのを作ってみました。
・セルA999をWORK用に使っています。
・対象となるセル式中に「HYPERLINK(」が一回しか出て来ない事が条件です。

Function GetURL(rTarget As Range) As String
　　Dim sStr1, sStr2, i
　　Dim sStr3 As String

　　If rTarget = "" Then Exit Function
　　sStr1 = Split(Range("A2").Formula, "HYPERLINK(")
　　sStr2 = Split(sStr1(1), ",")

　　For i = 0 To (UBound(sStr2) - 1)
　　　　sStr3 = sStr3 & sStr2(i) & ","
　　Next i
　　sStr3 = Mid(sStr3, 1, Len(sStr3) - 1)
　　Range("A999").Formula = "=" & sStr3
　　GetURL = Range("A999").Value
　　Range("A999").Clear
End Function

お礼

度々のご回答ありがとうございます。
そのままでは動かなかったので、下記の通り改造すると期待通りの動作をしました。

Function GetURL(rTarget As Range) As String
Dim sStr1, sStr2, i
Dim sStr3 As String

If rTarget = "" Then Exit Function
sStr1 = Split(rTarget.Formula, "HYPERLINK(") '←A2をrTargetに変更
sStr2 = Split(sStr1(1), ",")

For i = 0 To (UBound(sStr2) - 1)
sStr3 = sStr3 & sStr2(i) & ","
Next i
sStr3 = Mid(sStr3, 1, Len(sStr3) - 1)
Sheet1.Range("A999").Formula = "=" & sStr3 '←念のためシートの明確化
GetURL = Sheet1.Range("A999").Value '←念のためシートの明確化
Sheet1.Range("A999").Clear '←念のためシートの明確化
End Function

Excel 2010では動作未確認ですが、おそらく期待通りの動作をするだろうと思います。
こちらの結果は補足にてご報告させて頂きます。

アルゴリズムまで考えて頂き、本当にありがとうございました。
個人的にはもっとお手軽な方法があれば良いなと思っていたのですが、
やはり力技で行くしかないんですね（－－；

補足

Excel 2010でも動作することを確認しました。
ありがとうございました。

回答No.3

end-u

例えば
=IF(G14<>"",HYPERLINK(A1&IF(TEXT(TODAY(),"YY")=(MID(G14,3,2)),"~))","20"&(MID(G14,3,2))&"\")&G14&"Sample.xls", G14&"Sample.xls"),"")
こんな数式のような意地悪な事はないと思いますが　:)

Sub test()
　　Dim flg As Boolean
　　Dim f　 As String
　　Dim s　 As String
　　Dim c　 As Long
　　Dim i　 As Long

　　f = Selection.Formula
　　c = InStr(f, "HYPERLINK(")
　　If c > 0 Then
　　　　f = Mid(f, c + 10)
　　　　c = 0
　　　　For i = 1 To Len(f)
　　　　　　s = Mid(f, i, 1)
　　　　　　If s = """" Then flg = Not flg
　　　　　　If Not flg Then
　　　　　　　　Select Case s
　　　　　　　　Case "("
　　　　　　　　　　c = c + 1
　　　　　　　　Case ")"
　　　　　　　　　　c = c - 1
　　　　　　　　Case ","
　　　　　　　　　　If c = 0 Then Exit For
　　　　　　　　End Select
　　　　　　End If
　　　　Next
　　　　f = Left(f, i - 1)
　　　　Debug.Print f, Evaluate(f)
　　End If
End Sub

お礼

ご回答ありがとうございます。
Excel 2003にて、少し改造して動作確認したところ、こちらの内容でも動作することを確認しました。
Evaluate関数で計算式の実行結果が見られるのですね。
こちらもExcel 2010での動作確認結果を補足にて報告させていただきます。

補足

こちらについても、Excel 2010でも動作することを確認しました。
ありがとうございました。

回答No.1

mt2008

こういう事？
何か私が勘違いしている気がしますが……。

sStr = Split(Range("A1").Formula, ",")
MsgBox Right(sStr(0), Len(sStr(0)) - Len("=HYPERLINK("))

お礼

ご回答ありがとうございます。
ですが、ご回答いただいた内容では実現できませんでした。

付加条件(1)にある通り、「配置先」には複雑な分岐等があります。
これを詳しく書くと、以下の内容です。

=IF(G14="","",HYPERLINK(A1&IF(TEXT(TODAY(),"YY")=(MID(G14,3,2)),"~","20"&(MID(G14,3,2))&"\")&G14&"Sample.xls", G14&"Sample.xls"))

そのため、ご回答頂いたsStrの中身は以下のようになってしまいます。
=IF(G14=""

※正しくは上記のような内容ではありませんが、業務にかかわるので開示はご容赦ください。