エクセルについて質問です。

(ア)という文字列に(イ)というURLがハイパーリンク設定されているとします。(ア)という文字は青字で下線が入っており、クリックするとサイト(イ)にジャンプする状態です。
このようなセルがA1~A99方向に並んでいるのですが、これらのセルから(イ)だけを抽出する方法はありますか?
ハイパーリンクの編集や、ジャンプ先のURLを手作業で拾ってくるより効率的な関数などがあれば教えてください。

回答の条件
  • 1人2回まで
  • 登録:2007/04/20 10:27:26
  • 終了:2007/04/22 21:43:00

ベストアンサー

id:ardarim No.3

ardarim回答回数892ベストアンサー獲得回数1422007/04/21 05:00:24

ポイント50pt

以下のマクロをコピペして、ハイパーリンクのあるシートで実行してください。

B列にURLを書き出します。

Sub ExtractUrl()

    Dim m As Long
    Dim r As Long
    
    m = ActiveSheet.UsedRange.Rows.Count
    
    For r = 1 To m
        If Cells(r, 1).Hyperlinks.Count > 0 Then
            Cells(r, 2).Value = Cells(r, 1).Hyperlinks(1).Name
        End If
    Next r

End Sub
id:bar_emanon

できました!感謝!

2007/04/22 21:41:11

その他の回答(2件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692007/04/20 10:56:40

ポイント30pt

隣のB列にアドレスだけを挿入するマクロを自作してみました。

Sub AddLink()
    Dim hLink As Hyperlink
    For Each hLink In ActiveSheet.Hyperlinks
        Cells(hLink.Range.Row, 2).Value = hLink.Address
    Next
End Sub
id:bar_emanon

自作マクロ、ありがたいです!

2007/04/22 21:41:06
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692007/04/20 11:37:31

ポイント30pt

A列以外にもハイパーリンクがあるとまずいのでちょっと変更

Sub AddLink()
    Dim hLink As Hyperlink
    For Each hLink In ActiveSheet.Hyperlinks
        If hLink.Range.Column = 1 Then
            Cells(hLink.Range.Row, 2).Value = hylink.Address
        End If
    Next
End Sub

ユーザー定義関数を作ってみるとこんな感じ。すでにあったら無視して。

指定したセルのハイパーリンク先のアドレスを返す関数

Function AddLinks(target As Range)
    Dim hLink As Hyperlink
    For Each hLink In ActiveSheet.Hyperlinks
        If (hLink.Range.Row = target.Row) And (hLink.Range.Column = target.Column) Then
            AddLinks = hLink.Address
            Exit For
        End If
    Next
End Function
id:bar_emanon

ご丁寧にありがとうございます!

2007/04/22 21:41:09
id:ardarim No.3

ardarim回答回数892ベストアンサー獲得回数1422007/04/21 05:00:24ここでベストアンサー

ポイント50pt

以下のマクロをコピペして、ハイパーリンクのあるシートで実行してください。

B列にURLを書き出します。

Sub ExtractUrl()

    Dim m As Long
    Dim r As Long
    
    m = ActiveSheet.UsedRange.Rows.Count
    
    For r = 1 To m
        If Cells(r, 1).Hyperlinks.Count > 0 Then
            Cells(r, 2).Value = Cells(r, 1).Hyperlinks(1).Name
        End If
    Next r

End Sub
id:bar_emanon

できました!感謝!

2007/04/22 21:41:11

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません