こんにちは！ハイパーリンクしまくりのハイパーtknriaです！
みんな大好きハイパーリンク！
僕も仕事上、下図のように、URLデータを一覧にする作業があります。
例えば、
・ある展示会に出展している企業名と、企業概要を示すURL
・関連ニュース、トピックスのタイトルと、そのソース
などですね。
こうやってまとめた情報を使おうと、あるリンクに飛んだときに、セルに表示しているURLとリンクされたURLが異なる場合があります。
URLをコピーして、セルにペーストして、さらにそのハイパーリンク先としても指定して…という作業を繰り返していると、たまにミスっちゃうんですよね。人間だもの。
かといって、ある程度データを蓄積してからまとめて確認するのも大変ですし、データを追加する度に確認するのも面倒です。
そこで、一括ポン！でチェックするマクロを実装します。
■ VBAコード例
'----- 以下、ソース -----
Const DATA_MAX = 500
Const posi_URL = 3
Const posi_TITLE = 2
Sub ハイパーリンク確認_Click()
Dim i As Integer
Dim add_str As String
Dim error As String
With Worksheets("Sheet1")
For i = 1 To DATA_MAX
If .Cells(i, posi_URL).Hyperlinks.Count > 0 Then
add_str = .Cells(i, posi_URL).Hyperlinks(1).Address
If add_str = .Cells(i, posi_URL) Then
Else
error = error & vbCrLf & i & "行目：" & Left(.Cells(i, posi_TITLE), 15)
End If
Else
End If
Next i
End With
If error = "" Then
MsgBox ("内容一致！")
Else
MsgBox ("以下のハイパーリンクが間違っています。" & vbCrLf & error)
End If
End Sub
'----- 以上、ソース -----
Const DATA_MAX = 500
Const posi_URL = 3
Const posi_TITLE = 2
Sub ハイパーリンク確認_Click()
Dim i As Integer
Dim add_str As String
Dim error As String
With Worksheets("Sheet1")
For i = 1 To DATA_MAX
If .Cells(i, posi_URL).Hyperlinks.Count > 0 Then
add_str = .Cells(i, posi_URL).Hyperlinks(1).Address
If add_str = .Cells(i, posi_URL) Then
Else
error = error & vbCrLf & i & "行目：" & Left(.Cells(i, posi_TITLE), 15)
End If
Else
End If
Next i
End With
If error = "" Then
MsgBox ("内容一致！")
Else
MsgBox ("以下のハイパーリンクが間違っています。" & vbCrLf & error)
End If
End Sub
'----- 以上、ソース -----
■ 億劫なあとがき
今回はあくまでも、セル内容とリンク先が一致しているかを確認する機能です。
リンク切れかどうかを一括判定する機能も必要だと思うので、それも今後実装します。
