社会人&学生におすすめする色彩検定の勉強術

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

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

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

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

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

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

教えて!goo グレード

A 回答 (3件)

かなり強引だけどこんなのを作ってみました。


・セル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

この回答への補足

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

補足日時:2012/01/13 11:36
    • good
    • 0
この回答へのお礼

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

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

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

お礼日時:2012/01/13 10:00

例えば


=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 2010でも動作することを確認しました。
ありがとうございました。

補足日時:2012/01/13 11:36
    • good
    • 0
この回答へのお礼

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

お礼日時:2012/01/13 11:29

こういう事?


何か私が勘違いしている気がしますが……。

sStr = Split(Range("A1").Formula, ",")
MsgBox Right(sStr(0), Len(sStr(0)) - Len("=HYPERLINK("))
    • good
    • 0
この回答へのお礼

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

付加条件(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=""

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

お礼日時:2012/01/12 15:35

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

教えて!goo グレード

人気Q&Aランキング