VBA100本ノック 27本目：ハイパーリンクのURL

この記事から得るもの

セルに設定されているハイパーリンクの削除方法。
ハイパーリンクのアドレスをセルに書き出す。

１　今回のお題

WEBページからコピーしてシートに貼り付けたら、セルの文字列にハイパーリンクが付いてきました。
ハイパーリンクが付いているセルについて、
・右隣のセルにリンクのURLを出力
・ハイパーリンクを解除
※図は無視してください。
※対象シートは任意

f:id:bimori466:20201125054511p:plain

excel-ubara.com

２　今回のお題の意図

ハイパーリンクのアドレスは残しつつも、セルのハイパーリンクは削除する。

３　回答

私の回答

Sub ノック27本目_2()

Dim ws As Worksheet: Set ws = Worksheets("sheet1")

For i = 3 To ws.Cells(Rows.Count, 1).End(xlUp).Row
    'ハイパーリンクが設定されているかチェック
    If ws.Range(Cells(i, 1).Address).Hyperlinks.Count > 0 Then
        'ハイパーリンクアドレスの書き出し
        ws.Cells(i, 2) = ws.Range(Cells(i, 1).Address).Hyperlinks.Item(1).Address
        
        With ws.Cells(i, 1)
            .Hyperlinks.Delete  'ハイパーリンクの削除
        End With
    End If

Next


End Sub

ハイパーリンクのアドレスは、
「Range（cells（）.Address）.Hyperlinks.Item(1).Address」と記述するのですね。ハイパーリンクすらまともに使ったことがないので、初めて知りました。

削除するときはDeleteで、文字の青色、アンダーラインまで消した状態にすることができます。しかし、あえて文字の色、アンダーラインを残したい場合は、ハイパーリンクの削除ではなく「解除」という方法を取ります。

ハイパーリンクの解除

Sub ノック27本目_1()

Dim ws As Worksheet: Set ws = Worksheets("sheet1")

ll = ws.Range("A3").CurrentRegion.Rows.Count

For i = 3 To ws.Cells(Rows.Count, 1).End(xlUp).Row
    If ws.Range(Cells(i, 1).Address).Hyperlinks.Count > 0 Then
        ws.Cells(i, 2) = ws.Range(Cells(i, 1).Address).Hyperlinks.Item(1).Address
        
        With ws.Cells(i, 1)
            .ClearHyperlinks    'ハイパーリンクの解除
            '.Font.Underline = False        ’アンダーラインの解除
            '.Font.ColorIndex = xlAutomatic ’文字を黒色
        End With
    End If

Next

End Sub