【エクセルVBA】ハイパーリンクの表示文字列（セル内容）とアドレスが同じか確認するマクロ

こんにちは
Excel VBA ベーシックの資格は持っているのですが、スタンダードは受験したことないので、受験しようかなと思っている星野です。

WEB業界で働ていると、遷移先URLをエクセルでいただく場合が多々あるとおもいます。

しかし、稀に下記のように『表示文字列（セル内容）』と『アドレス』が違うものが入っていることがあります。

1つなら、ハイパーリンクの編集から念のため確認すればいいですが、たくさんのリンクがある場合1つ1つ確認するのは大変です。

そこで、『表示文字列（セル内容）』と『アドレス』が違うセルを赤くするマクロを作成しました。

ハイパーリンクの表示文字列（セル内容）とアドレスを比較するマクロ
バグなどがあればコメント欄に記入お願いいたします。

ハイパーリンクの表示文字列（セル内容）とアドレスを比較するマクロ

ハイパーリンクの入ったセルを選択して（複数セル可能！）マクロを実行します。

表示文字列（セル内容）とアドレスが異なる場合セルが赤くなります。

Sub HighlightDifferentHyperlinks()
Dim cell As Range
Dim selectedRange As Range
Dim hyperlinkAddress As String
Dim cellValue As String

'選択範囲を設定
On Error Resume Next
Set selectedRange = Selection
On Error GoTo 0

'選択範囲内のセルをチェック
For Each cell In selectedRange
  If cell.Hyperlinks.Count > 0 Then
    'アドレスを取得する（半角スペースはUELエンコードする。アンカーがあるか無いかで処理が分かれる）
    If cell.Hyperlinks(1).SubAddress <> "" Then
      hyperlinkAddress = Replace(cell.Hyperlinks(1).Address & "#" & cell.Hyperlinks(1).SubAddress, Space(1), "%20")
    Else
      hyperlinkAddress = Replace(cell.Hyperlinks(1).Address, Space(1), "%20")
    End If

    '表示文字列を取得
    cellValue = cell.Value

    '比較して違う場合は赤く塗る
    If hyperlinkAddress <> cellValue Then
    cell.Interior.Color = RGB(255, 0, 0) '赤
    '条件付き書式などで背景色が設定されていて変更が出来ない場合に文字に色を付けるのであれば下記のコードを使う
    'cell.Font.Color = RGB(255, 0, 0) '赤
    Else
    cell.Interior.Color = xlNone '塗りつぶしなし
    End If
  End If
Next cell

MsgBox "確認が完了しました。", vbInformation
End Sub

Sub HighlightDifferentHyperlinks()

Dim cell As Range

Dim selectedRange As Range

Dim hyperlinkAddress As String

Dim cellValue As String

'選択範囲を設定

On Error Resume Next

Set selectedRange = Selection

On Error GoTo 0

'選択範囲内のセルをチェック

For Each cell In selectedRange

If cell.Hyperlinks.Count > 0 Then

'アドレスを取得する（半角スペースはUELエンコードする。アンカーがあるか無いかで処理が分かれる）

If cell.Hyperlinks(1).SubAddress <> "" Then

hyperlinkAddress = Replace(cell.Hyperlinks(1).Address & "#" & cell.Hyperlinks(1).SubAddress, Space(1), "%20")

Else

hyperlinkAddress = Replace(cell.Hyperlinks(1).Address, Space(1), "%20")

End If

'表示文字列を取得

cellValue = cell.Value

'比較して違う場合は赤く塗る

If hyperlinkAddress <> cellValue Then

cell.Interior.Color = RGB(255, 0, 0) '赤

'条件付き書式などで背景色が設定されていて変更が出来ない場合に文字に色を付けるのであれば下記のコードを使う

'cell.Font.Color = RGB(255, 0, 0) '赤

Else

cell.Interior.Color = xlNone '塗りつぶしなし

End If

Next cell

MsgBox "確認が完了しました。", vbInformation

End Sub

バグなどがあればコメント欄に記入お願いいたします。

テストは最小限しかしていないため、バグなどを発見した場合はコメントでご指摘いただけますと幸いです。