生成AI活用研究
生成AIと100本ノック 27本目：ハイパーリンクのURL

Geminiを中心に生成AIの活用と研究の記録
公開日：2025-06-07　最終更新日：2025-06-07

生成AIと100本ノック 27本目：ハイパーリンクのURL


AIのGeminiがVBA100本ノックに挑戦！
ということでシリーズを開始しましたが、ある程度回もすすんだので、検証方法を変更することにしました。


独自に作成した、VBA開発の汎用プロンプト（命名：AI神髄VBA）が、他のお題で確認している範囲内では、かなり良い成果を出せています。
そこで、このプロンプトのさらなる改善と最終検証を目的として、100本ノックを進めていくことにします。

以下の代表的な生成AI3つで確認を進めます。
🤖 Gemini（2.5 Pro）（課金済の有料版）
🤖 ChatGPT（GPT-3.5）（無課金の無料版）
🤖 Claude（Sonnet4）（無課金の無料版）



VBA100本ノックの出題と解答

VBA100本ノック 27本目：ハイパーリンクのURL
・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ


Geminiへの出題とGeminiの回答

Geminiの回答 Geminiへの出題
VBA マクロ 生成AIと100本ノック ハイパーリンク

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

-------------------- ここから共通プロンプト --------------------
承知いたしました。
ご依頼の件、承知いたしました。Webページからコピーした際に付与されるハイパーリンクを指定のルールで一括処理する、業務品質レベルのVBAコードを作成します。

提示された「共通プロンプト」の全要件を完全に遵守し、高速性、堅牢性、保守性を最大限に考慮して設計・実装します。

VBAコード
Option Explicit

'=========================================
' メインモジュール
' VBAの実行は、このモジュールにある Main_ProcessHyperlinks プロシージャーから開始してください。
'=========================================

'-----------------------------------------
' 機能: アクティブシート上のハイパーリンクを処理するメインプロシージャー
' 引数: なし
' 戻り値: なし
' 備考: 全体的な処理フローを制御し、各サブプロシージャーを呼び出す。
'　　　 このプロシージャーを実行してください。
'-----------------------------------------
Public Sub Main_ProcessHyperlinks()
　　' --- 変数宣言 ---
　　Dim wsTarget As Worksheet
　　Dim lngOriginalCalc As Long

　　' --- 初期設定 ---
　　On Error GoTo ErrorHandler
　　Set wsTarget = ActiveSheet
　　
　　' アクティブシートが存在しないという極端なケースを考慮
　　If wsTarget Is Nothing Then
　　　　MsgBox "処理対象のアクティブなシートがありません。", vbExclamation
　　　　Exit Sub
　　End If

　　' --- 高速化/環境設定 ---
　　Call ApplyApplicationSettings(lngOriginalCalc)

　　' --- 主処理の実行 ---
　　Call ProcessHyperlinksInSheet(wsTarget)

　　' --- 終了処理 ---
　　MsgBox "処理が完了しました。", vbInformation

Cleanup:
　　' --- 設定復元 ---
　　Call ResetApplicationSettings(lngOriginalCalc)
　　Set wsTarget = Nothing
　　Exit Sub

ErrorHandler:
　　' --- エラー処理 ---
　　MsgBox "予期せぬエラーが発生しました。処理を中断します。" & vbCrLf & vbCrLf & _
　　　　　 "エラー番号: " & Err.Number & vbCrLf & _
　　　　　 "エラー内容: " & Err.Description & vbCrLf & _
　　　　　 "発生プロシージャ: Main_ProcessHyperlinks", vbCritical
　　GoTo Cleanup
End Sub


'=========================================
' データ加工・ロジックモジュール
'=========================================

'-----------------------------------------
' 機能: 指定されたシート内のすべてのハイパーリンクを処理する
' 引数: wsTarget (Worksheet) - 処理対象のワークシートオブジェクト
' 戻り値: なし
' 備考: ハイパーリンクのURLを右隣のセルに出力し、元のハイパーリンクを削除する。
'　　　 コレクションをループしながら要素を削除するため、逆順ループで安全に処理する。
'-----------------------------------------
Private Sub ProcessHyperlinksInSheet(ByVal wsTarget As Worksheet)
　　' --- 変数宣言 ---
　　Dim objHyperlink As Object ' Hyperlinkオブジェクト
　　Dim i As Long

　　' --- 事前チェック (アーリーリターン) ---
　　If wsTarget.Hyperlinks.Count = 0 Then Exit Sub ' ハイパーリンクがなければ処理不要

　　' --- ハイパーリンクのループ処理 ---
　　' コレクションの要素を削除しながらループするため、インデックスを使い末尾から逆順に処理する
　　For i = wsTarget.Hyperlinks.Count To 1 Step -1
　　　　Set objHyperlink = wsTarget.Hyperlinks(i)

　　　　' 特定のハイパーリンクでエラーが起きても処理を続行するため、局所的にエラーを無視する
　　　　On Error Resume Next
　　　　
　　　　' ハイパーリンクのアドレス(URL)を右隣のセルに出力
　　　　objHyperlink.Range.Offset(0, 1).Value = objHyperlink.Address
　　　　
　　　　' ハイパーリンクを削除
　　　　objHyperlink.Delete
　　　　
　　　　' エラーハンドリングを通常の状態に戻す
　　　　On Error GoTo 0
　　Next i
　　
　　Set objHyperlink = Nothing
End Sub


'=========================================
' ユーティリティモジュール
'=========================================

'-----------------------------------------
' 機能: Excelのアプリケーション設定を高速化用に変更する
' 引数: lngOriginalCalc (Long) - 元の計算方法を格納するための変数 (参照渡し)
' 戻り値: なし
' 備考: メイン処理の開始時に呼び出す。
'-----------------------------------------
Private Sub ApplyApplicationSettings(ByRef lngOriginalCalc As Long)
　　Application.ScreenUpdating = False
　　Application.EnableEvents = False
　　lngOriginalCalc = Application.Calculation ' 元の計算方法を記憶
　　Application.Calculation = xlCalculationManual
　　Application.DisplayAlerts = False
End Sub

'-----------------------------------------
' 機能: Excelのアプリケーション設定を処理前の状態に戻す
' 引数: lngOriginalCalc (Long) - 記憶しておいた元の計算方法
' 戻り値: なし
' 備考: 処理終了時またはエラー発生時に必ず呼び出す。
'-----------------------------------------
Private Sub ResetApplicationSettings(ByVal lngOriginalCalc As Long)
　　' lngOriginalCalcが初期値(0)でなければ、記憶した設定に戻す
　　If lngOriginalCalc <> 0 Then
　　　　Application.Calculation = lngOriginalCalc
　　Else
　　　　' 万が一記憶できていない場合は、安全のため自動計算に戻す
　　　　Application.Calculation = xlCalculationAutomatic
　　End If
　　Application.DisplayAlerts = True
　　Application.EnableEvents = True
　　Application.ScreenUpdating = True
End Sub

VBAコードの解説
  1. 概要
    このVBAコードは、現在アクティブになっているExcelシートに含まれる全てのハイパーリンクを検出し、「URLを右隣のセルに転記」してから「元のハイパーリンクを解除」する一連の作業を自動化します。
  2. 使用方法
    1. Excelで Alt + F11 キーを押し、VBE（Visual Basic Editor）を開きます。
    2. メニューの「挿入」から「標準モジュール」を選択します。
    3. 表示されたコードウィンドウに、上記のVBAコードを全てコピーして貼り付けます。
    4. VBEを閉じてExcelに戻ります。
    5. ハイパーリンクを処理したいシートをアクティブ（表示した状態）にします。
    6. Alt + F8 キーを押してマクロ一覧ダイアログを開き、Main_ProcessHyperlinks を選択して「実行」ボタンを押します。
  3. プロシージャーの構成と役割
    • プロシージャー名 種類 役割
      Main_ProcessHyperlinks メイン 全体の処理の流れを管理する司令塔。高速化設定やエラー処理も担当します。
      ProcessHyperlinksInSheet ロジック ハイパーリンクのURL抽出と解除という、中心的な処理を専門に実行します。
      ApplyApplicationSettings ユーティリティ 処理前にExcelの動作を高速化するための設定を適用します。
      ResetApplicationSettings ユーティリティ 処理後（エラー発生時も含む）にExcelの設定を元に戻し、安全に終了させます。
  4. 主要な処理のポイント
    • 安全なループ処理:
      シート上のハイパーリンクを一つずつ削除していくため、通常の For Each ループでは問題が起きる可能性があります。そこで、For i = コレクションの数 To 1 Step -1 という構文を使い、コレクションの末尾から逆順に処理することで、安全かつ確実に全ハイパーリンクを処理しています。
    • 高速化対応:処理の開始時に画面更新や自動計算を一時的に停止し、終了時に元に戻すことで、大量のハイパーリンクがあってもスムーズに処理が完了するように配慮しています。
    • 堅牢なエラーハンドリング:
      • 全体のエラー処理: Main_ProcessHyperlinks で予期せぬエラーが発生した場合、Excelの設定を元に戻してからエラー内容を通知し、安全に処理を中断します。
      • 局所的なエラー処理: ProcessHyperlinksInSheet 内では、万が一特定のハイパーリンクの処理に失敗しても（例：セルが保護されている等）、マクロ全体が止まらず次のハイパーリンクの処理に進むよう On Error Resume Next を限定的に使用しています。

なぜか、Gemini内部のVBA作製時のルールが文字化けで出力されてしまうという事態が・・・
こういう安定しないのも、今の生成AIの良さなのか、悪さなのか・・・
VBAは問題ありません。


ChatGPTへの出題とChatGPTの回答

AI神髄VBAの回答 AI神髄VBAへの出題
Geminiと同じ画像

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

-------------------- ここから共通プロンプト --------------------
以下に、指定要件を完全に満たすVBAコードとその解説を提示します。
このコードは、すべてのハイパーリンク付きセルの隣にURLを抽出して出力し、ハイパーリンクを解除するものです。

【VBAコード】
Option Explicit

'-----------------------------------------
' 機能: メイン処理（ハイパーリンクのURL抽出と解除）
' 引数: なし
' 戻り値: なし
' 備考: エラーハンドリングと高速化処理を含む
'-----------------------------------------
Public Sub ExecuteHyperlinkProcessing()
　　
　　Dim bScreenUpdating As Boolean
　　Dim bEnableEvents As Boolean
　　Dim bDisplayAlerts As Boolean
　　Dim xlCalcMode As XlCalculation
　　
　　On Error GoTo ErrorHandler
　　
　　' 現在のアプリケーション設定を保存
　　bScreenUpdating = Application.ScreenUpdating
　　bEnableEvents = Application.EnableEvents
　　bDisplayAlerts = Application.DisplayAlerts
　　xlCalcMode = Application.Calculation
　　
　　' 高速化設定
　　Application.ScreenUpdating = False
　　Application.EnableEvents = False
　　Application.DisplayAlerts = False
　　Application.Calculation = xlCalculationManual

　　' 初期化・準備
　　Dim wsTarget As Worksheet
　　Set wsTarget = PrepareTargetWorksheet()
　　
　　' データ処理
　　Dim arrResult() As Variant
　　arrResult = ExtractHyperlinks(wsTarget)

　　' 結果出力
　　OutputHyperlinkInfo wsTarget, arrResult

Cleanup:
　　' 設定を元に戻す
　　Application.ScreenUpdating = bScreenUpdating
　　Application.EnableEvents = bEnableEvents
　　Application.DisplayAlerts = bDisplayAlerts
　　Application.Calculation = xlCalcMode
　　Exit Sub

ErrorHandler:
　　MsgBox "エラーが発生しました: " & vbCrLf & _
　　　　　 "番号: " & Err.Number & vbCrLf & _
　　　　　 "内容: " & Err.Description, vbCritical, "実行時エラー"
　　Resume Cleanup
End Sub

'-----------------------------------------
' 機能: 対象シートの準備（アクティブシートを想定）
' 引数: なし
' 戻り値: Worksheet - 対象のワークシート
' 備考: アクティブシートを対象とする
'-----------------------------------------
Private Function PrepareTargetWorksheet() As Worksheet
　　Set PrepareTargetWorksheet = ActiveSheet
End Function

'-----------------------------------------
' 機能: ハイパーリンク付きセルのURL抽出と解除情報取得
' 引数: wsTarget (Worksheet) - 対象シート
' 戻り値: Variant配列 - {行, 列, URL}の配列
' 備考: UsedRange ではなく Cells.SpecialCells を使用
'-----------------------------------------
Private Function ExtractHyperlinks(ByRef wsTarget As Worksheet) As Variant
　　Dim colResults As Collection
　　Set colResults = New Collection

　　Dim rngCell As Range
　　Dim rngArea As Range

　　On Error Resume Next
　　Set rngArea = wsTarget.Cells.SpecialCells(xlCellTypeConstants)
　　On Error GoTo 0

　　If rngArea Is Nothing Then
　　　　Exit Function
　　End If

　　Dim varCell As Variant
　　For Each varCell In rngArea
　　　　Set rngCell = varCell
　　　　If rngCell.Hyperlinks.Count > 0 Then
　　　　　　Dim sURL As String
　　　　　　sURL = rngCell.Hyperlinks(1).Address
　　　　　　
　　　　　　Dim arrTmp(1 To 3) As Variant
　　　　　　arrTmp(1) = rngCell.Row
　　　　　　arrTmp(2) = rngCell.Column
　　　　　　arrTmp(3) = sURL
　　　　　　colResults.Add arrTmp
　　　　End If
　　Next varCell

　　ExtractHyperlinks = CollectionToArray(colResults)
End Function

'-----------------------------------------
' 機能: ハイパーリンク情報の配列をワークシートに出力
' 引数: wsTarget (Worksheet) - 対象シート
' 　　　 arrResult (Variant) - URL抽出結果配列
' 戻り値: なし
' 備考: ハイパーリンクを解除し、隣のセルにURLを記載
'-----------------------------------------
Private Sub OutputHyperlinkInfo(ByRef wsTarget As Worksheet, ByRef arrResult As Variant)
　　Dim i As Long

　　If IsEmpty(arrResult) Then Exit Sub

　　For i = LBound(arrResult) To UBound(arrResult)
　　　　Dim lRow As Long, lCol As Long
　　　　lRow = arrResult(i)(1)
　　　　lCol = arrResult(i)(2)
　　　　
　　　　' URLを右隣セルに出力
　　　　wsTarget.Cells(lRow, lCol + 1).Value = arrResult(i)(3)
　　　　
　　　　' ハイパーリンク解除（文字列だけ残す）
　　　　wsTarget.Hyperlinks.Delete
　　Next i
End Sub

'-----------------------------------------
' 機能: Collectionを二次元Variant配列に変換
' 引数: col (Collection) - 入力データ
' 戻り値: Variant - 二次元配列
' 備考: 配列のReDim Preserve制限を回避
'-----------------------------------------
Private Function CollectionToArray(ByRef col As Collection) As Variant
　　Dim arr() As Variant
　　Dim i As Long

　　If col.Count = 0 Then
　　　　CollectionToArray = Empty
　　　　Exit Function
　　End If

　　ReDim arr(1 To col.Count)
　　For i = 1 To col.Count
　　　　arr(i) = col(i)
　　Next i

　　CollectionToArray = arr
End Function

【コード解説】
  • 区分 説明
    ExecuteHyperlinkProcessing メイン処理。高速化設定 → 対象シート取得 → ハイパーリンク抽出 → 出力処理。すべてのプロシージャを連携させる。
    PrepareTargetWorksheet アクティブシートを処理対象として返す準備用。必要に応じて固定名に変更も可。
    ExtractHyperlinks ハイパーリンク付きセルを走査し、行番号・列番号・URLを収集。UsedRangeではなく SpecialCells(xlCellTypeConstants) を使用。
    OutputHyperlinkInfo 抽出したURLを元に、対象セルの右隣へURLを出力し、ハイパーリンクを削除（文字列のみ保持）。
    CollectionToArray ReDim Preserve の制限回避のため、Collectionから配列に変換。
【特筆ポイント】
  • UsedRange非依存：貼り付けデータの範囲が変動する前提を考慮し、SpecialCells を使用。
  • 高速化・堅牢性：計算停止や画面更新オフ、例外処理を網羅。
  • 保守性・拡張性：明確なプロシージャ分離と型宣言。
  • ReDim Preserve禁止順守：Collectionで回避済み。
  • URL取得だけでなく、"右隣にURLを出力 + ハイパーリンク解除"という業務要件を完全に満たす。
ご希望に応じて、以下のカスタマイズも可能です：
  • 対象列の限定（例：列Aのみ）
  • 特定シート名の指定
  • ハイパーリンクのあるセルの書式変更
ご希望があれば、追加で対応いたします。

1回目は、画像の分析を始めてしまいました。
再度プロンプトを送信したら、普通に回答してきました。
VBAには問題はありません。


Claudeへの出題とClaudeの回答

AI神髄VBAの回答 AI神髄VBAへの出題
Geminiと同じ画像

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

-------------------- ここから共通プロンプト --------------------
エラー1004が再度発生していますね。処理済み件数が0ということから、ハイパーリンクへのアクセス自体に問題があるようです。より安全なアプローチでコードを全面的に見直します。

Option Explicit

'-----------------------------------------
' 機能: ハイパーリンク付きセルのURL抽出とリンク解除のメイン制御
' 引数: なし
' 戻り値: なし
' 備考: アクティブシートを対象とし、処理の高速化設定を適用
'-----------------------------------------
Sub Main_ProcessHyperlinks()
　　On Error GoTo ErrorHandler
　　
　　' 高速化設定の保存と適用
　　Call SetApplicationSettings(False)
　　
　　' 処理対象シートの取得
　　Dim wsTarget As Worksheet
　　Set wsTarget = ActiveSheet
　　
　　' ハイパーリンクの処理実行
　　Call ProcessHyperlinksInWorksheet(wsTarget)
　　
　　' 高速化設定の復元
　　Call SetApplicationSettings(True)
　　Exit Sub
　　
ErrorHandler:
　　Call SetApplicationSettings(True)
　　MsgBox "エラーが発生しました: " & Err.Description & vbCrLf & _
　　　　　 "エラー番号: " & Err.Number, vbCritical, "エラー"
End Sub

'-----------------------------------------
' 機能: ワークシート内のハイパーリンクを安全に処理
' 引数: wsTarget (Worksheet) - 処理対象のワークシート
' 戻り値: なし
' 備考: 使用範囲内のセルを個別にチェックしてハイパーリンクを処理
'-----------------------------------------
Sub ProcessHyperlinksInWorksheet(ByRef wsTarget As Worksheet)
　　On Error GoTo ErrorHandler
　　
　　Dim rngUsed As Range
　　Dim rngCell As Range
　　Dim lngProcessedCount As Long
　　
　　' 使用範囲の取得
　　Set rngUsed = GetUsedRange(wsTarget)
　　If rngUsed Is Nothing Then
　　　　MsgBox "処理対象の範囲が見つかりませんでした。", vbInformation, "情報"
　　　　Exit Sub
　　End If
　　
　　' 各セルのハイパーリンクをチェック
　　For Each rngCell In rngUsed
　　　　If HasHyperlink(rngCell) Then
　　　　　　Call ProcessSingleHyperlink(rngCell)
　　　　　　lngProcessedCount = lngProcessedCount + 1
　　　　End If
　　Next rngCell
　　
　　' 処理完了メッセージ
　　If lngProcessedCount > 0 Then
　　　　MsgBox "処理完了: " & lngProcessedCount & "個のハイパーリンクを処理しました。", _
　　　　　　　 vbInformation, "処理結果"
　　Else
　　　　MsgBox "処理対象のハイパーリンクが見つかりませんでした。", vbInformation, "情報"
　　End If
　　
　　Exit Sub
　　
ErrorHandler:
　　MsgBox "ハイパーリンク処理中にエラーが発生しました: " & Err.Description & vbCrLf & _
　　　　　 "エラー番号: " & Err.Number & vbCrLf & _
　　　　　 "処理済み件数: " & lngProcessedCount, vbCritical, "エラー"
End Sub

'-----------------------------------------
' 機能: 単一セルのハイパーリンクを処理
' 引数: rngCell (Range) - 処理対象のセル
' 戻り値: なし
' 備考: URLを右隣のセルに出力し、ハイパーリンクを削除
'-----------------------------------------
Sub ProcessSingleHyperlink(ByRef rngCell As Range)
　　On Error Resume Next
　　
　　Dim strUrl As String
　　Dim rngOutput As Range
　　
　　' ハイパーリンクのURLを取得
　　If rngCell.Hyperlinks.Count > 0 Then
　　　　strUrl = rngCell.Hyperlinks(1).Address
　　　　
　　　　' 右隣のセルにURLを出力
　　　　Set rngOutput = rngCell.Offset(0, 1)
　　　　If Not rngOutput Is Nothing Then
　　　　　　rngOutput.Value = strUrl
　　　　End If
　　　　
　　　　' ハイパーリンクを削除
　　　　rngCell.Hyperlinks.Delete
　　End If
　　
　　' エラーが発生した場合はクリア
　　If Err.Number <> 0 Then
　　　　Err.Clear
　　End If
　　
　　On Error GoTo 0
End Sub

'-----------------------------------------
' 機能: セルにハイパーリンクが存在するかチェック
' 引数: rngCell (Range) - チェック対象のセル
' 戻り値: Boolean - ハイパーリンクが存在する場合True
' 備考: エラー回避のため安全にチェック
'-----------------------------------------
Function HasHyperlink(ByRef rngCell As Range) As Boolean
　　On Error Resume Next
　　
　　HasHyperlink = False
　　
　　If Not rngCell Is Nothing Then
　　　　If rngCell.Hyperlinks.Count > 0 Then
　　　　　　HasHyperlink = True
　　　　End If
　　End If
　　
　　If Err.Number <> 0 Then
　　　　Err.Clear
　　　　HasHyperlink = False
　　End If
　　
　　On Error GoTo 0
End Function

'-----------------------------------------
' 機能: ワークシートの使用範囲を安全に取得
' 引数: wsTarget (Worksheet) - 対象のワークシート
' 戻り値: Range - 使用範囲（取得できない場合はNothing）
' 備考: CurrentRegionとUsedRangeを組み合わせて最適な範囲を取得
'-----------------------------------------
Function GetUsedRange(ByRef wsTarget As Worksheet) As Range
　　On Error Resume Next
　　
　　Dim rngUsed As Range
　　
　　' まずUsedRangeを試行
　　Set rngUsed = wsTarget.UsedRange
　　
　　' UsedRangeが取得できない場合は、A1からの範囲を使用
　　If rngUsed Is Nothing Then
　　　　Set rngUsed = wsTarget.Range("A1").CurrentRegion
　　End If
　　
　　' それでも取得できない場合は、A1セルのみ
　　If rngUsed Is Nothing Then
　　　　Set rngUsed = wsTarget.Range("A1")
　　End If
　　
　　Set GetUsedRange = rngUsed
　　
　　If Err.Number <> 0 Then
　　　　Err.Clear
　　　　Set GetUsedRange = Nothing
　　End If
　　
　　On Error GoTo 0
End Function

'-----------------------------------------
' 機能: アプリケーション設定の変更（高速化用）
' 引数: blnRestore (Boolean) - True:元に戻す, False:高速化設定
' 戻り値: なし
' 備考: 処理の高速化と復元を行う
'-----------------------------------------
Sub SetApplicationSettings(ByRef blnRestore As Boolean)
　　On Error Resume Next
　　
　　If blnRestore Then
　　　　' 設定を元に戻す
　　　　Application.ScreenUpdating = True
　　　　Application.Calculation = xlCalculationAutomatic
　　　　Application.EnableEvents = True
　　　　Application.DisplayAlerts = True
　　Else
　　　　' 高速化設定を適用
　　　　Application.ScreenUpdating = False
　　　　Application.Calculation = xlCalculationManual
　　　　Application.EnableEvents = False
　　　　Application.DisplayAlerts = False
　　End If
　　
　　On Error GoTo 0
End Sub

修正内容の説明
エラー1004の根本的な原因は、Hyperlinksコレクションへの直接アクセスにあると判断し、より安全なアプローチに全面的に変更しました。
主な変更点
  1. セル単位での処理に変更
    • Hyperlinksコレクションを直接操作する代わりに、各セルを個別にチェック
    • For Each rngCell In rngUsed でセル単位の処理
  2. 安全なハイパーリンクチェック
    • HasHyperlink関数で事前にハイパーリンクの存在を確認
    • エラー回避のためOn Error Resume Nextを使用
  3. 堅牢な範囲取得
    • GetUsedRange関数で安全に処理範囲を取得
    • UsedRangeが取得できない場合のフォールバック処理
  4. 個別処理の実装
    • ProcessSingleHyperlinkでセル単位の処理
    • rngCell.Hyperlinks(1).AddressでURLを取得
    • rngCell.Hyperlinks.Deleteで削除
処理フロー
  1. ワークシートの使用範囲を取得
  2. 各セルをループ処理
  3. ハイパーリンクが存在するセルを検出
  4. URLを右隣のセルに出力
  5. ハイパーリンクを削除
  6. 処理完了件数を表示
エラー対策
  • 各処理段階でOn Error Resume Nextを使用
  • エラー発生時の適切なクリア処理
  • Nothingチェックによる安全なオブジェクト操作
この修正により、ハイパーリンクコレクションの操作に起因するエラー1004を回避し、安定した処理が可能になります。

以下のエラーが2回発生しました。

VBA マクロ 生成AIと100本ノック ハイパーリンク

エラー報告して、上記のVBAが出力されました。
エラーは解消されています。



同じテーマ「生成AI活用研究」の記事

Geminiと100本ノック 19本目：図形のコピー
Geminiと100本ノック 20本目：ブックのバックアップ
Geminiと100本ノック 21本目：バックアップファイルの削除
Geminiと100本ノック 22本目：FizzBuzz発展問題
Geminiと100本ノック 23本目：シート構成の一致確認
Geminiと100本ノック 24本目：全角英数のみ半角
Geminiと100本ノック 25本目：マトリックス表をDB形式に変換
生成AIと100本ノック 26本目：ファイル一覧作成
生成AIと100本ノック 27本目：ハイパーリンクのURL
生成AIと100本ノック 28本目：シートをブックに分割
生成AIと100本ノック 29本目：画像の挿入


新着記事NEW ・・・新着記事一覧を見る

AIは便利なはずなのに…「AI疲れ」が次の社会問題になる｜生成AI活用研究(2026-02-16)
カンマ区切りデータの行展開｜エクセル練習問題(2026-01-28)
開いている「Excel/Word/PowerPoint」ファイルのパスを調べる方法｜エクセル雑感(2026-01-27)
IMPORTCSV関数（CSVファイルのインポート）｜エクセル入門(2026-01-19)
IMPORTTEXT関数（テキストファイルのインポート）｜エクセル入門(2026-01-19)
料金表（マトリックス）から金額で商品を特定する｜エクセル練習問題(2026-01-14)
「緩衝材」としてのVBAとRPA｜その終焉とAIの台頭｜エクセル雑感(2026-01-13)
シンギュラリティ前夜：AIは機械語へ回帰するのか｜生成AI活用研究(2026-01-08)
電卓とプログラムと私｜エクセル雑感(2025-12-30)
VLOOKUP/XLOOKUPが異常なほど遅くなる危険なアンチパターン｜エクセル関数応用(2025-12-25)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.日本の祝日一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.FILTER関数（範囲をフィルター処理）｜エクセル入門
5.RangeとCellsの使い方｜VBA入門
6.繰り返し処理（For Next)｜VBA入門
7.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
8.マクロとは？VBAとは？VBAでできること｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.メッセージボックス(MsgBox関数)｜VBA入門



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。
This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ
同じテーマの記事
新着記事
アクセスランク


↑