30分の過去動画＋ソースコードからブログのひな型を作成するテスト 26年06月にテスト

現在私は「過去動画の字幕を修正しています」と突然の自分語りからブログを始めて、
作業内容としては、過去動画と読み方の資料として、ソースコードを渡し、字幕を修正しています。
そのついでで、フト、
過去動画
と
ソースコードから
ブログを急く生出来ないか？と思い、作成したテストが下記です。
※今の時代、ここまでできるんですね。
※※おっと、他の作業してないで、字幕修正に戻らないとなぁ・・・

AIでコードを作成する時代で、
AIに過去動画と過去ソースを渡して、ブログのひな型を作成してもらった話って、違うか・・・
下記、作成したブログです※前説、自分語りが長くてすみません

コピペ量産マクロの限界！12レース分の処理を「たった1つのループ」に集約して絶望を希望に変えるVBA構造化テクニック

コピペで膨れ上がったマクロに絶望していませんか？

「1リクエスト分の処理がうまく動いたから、2回目、3回目はコードをそのままコピー＆ペーストして並べちゃえ！」

VBAを始めたばかりの頃、誰もが一度はやってしまう力技のプログラム。とりあえず動くからいいや…と安心したのも束の間、ほんの少しの修正（「データを書き込む位置を1行ずらしたい」「空行を1行足したい」など）が入った瞬間に地獄が始まります。コピペした12箇所すべてを、目を皿のようにして手作業で直していく絶望感。1箇所でも修正を忘れたら即バグの原因になります。

この記事では、そんな''「コピペ量産のクソプログラム」''が、なぜ現場で嫌われるのか、そして''「変数とFor～Nextループ」''を使うことで、どれほど美しく、メンテナンスしやすくなるのかを実演解説します。

当時のInternet Explorer（IE）操作を題材にしていますが、ここで解説する''「プログラムの構造化・リファクタリングの思考プロセス」''は、現代のExcel操作や最新ブラウザの自動化（Selenium等）でも完全に共通する不変の基礎知識です。

「1カ所直すと12カ所直さなきゃいけない地獄」から今すぐ脱出しましょう！

【当時の原文】コピペで量産したマクロ（ ie_copy_pe ）

まずは、1レース分の処理をベースに、2レース目、3レース目と同じコードをひたすら下にコピペして繋ぎ合わせた、当時の「クソプログラム」の構造をご覧ください。7レース分だけでも膨大な行数になり、途中で何をやっているか分からなくなります。

Sub ie_copy_pe()  'IEの表示をテストする。

'IEの起動
    Dim objIE As InternetExplorer '変数を定義します。
    Set objIE = CreateObject("InternetExplorer.Application") 'オブジェクトを作成します。
    objIE.Visible = True      '可視、Trueで見えるようにします。
    
'表示位置(左上の座標)とサイズ(高さ・幅)を調整する
    objIE.FullScreen = False '※Trueのモードだとびっくりするよ
    objIE.Top = 0      '左上 上位置
    objIE.Left = 0     '左上 左位置
    objIE.Width = 800    '横幅
    objIE.Height = 600   '高さ
    
'XXXバー、外観・外枠の調整。
    objIE.Toolbar = True     'タブの切り替えで必要なので、ツールバーを表示にする
    objIE.MenuBar = False    'メニューは非表示にする
    objIE.AddressBar = True  'URLなど アドレスバーは確認のため、表示する
    objIE.StatusBar = True   '一番下のステータスバーを表示。

'処理したいページを表示します。
    objIE.Navigate "http://www.jra.go.jp/"  '.Navigate メソッドで JRA表示する。
    'Navigate と Navigate2 の 違いが私もイマイチわかってませんが

'ページの表示完了を待ちます。
    While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。
        DoEvents  '重いので嫌いな人居るけど。
    Wend
    
'ページが表示されたので、表示された文章に対して、処理を行います。
    'HTML文章objIE.Documentからデータを取得
    '入力フォームDocument.Formsでデータをセットしたり送信したり
    'リンクDocument.Linksでリンクの情報を取得
    
        
    Dim i     As Integer '添え字 i番目などで使用
    Dim yLINE As Integer '行カウンタ、Y行目
    
    Dim oDocument As HTMLDocument
    Dim objA As HTMLAnchorElement
    
    Range("A1") = "調査したURLは " & strURL & " です"  'A1にURLを記述(セット)
    Range("D1") = "リンクの数は " & objIE.Document.Links.Length & "です"  'D1にリンクの数をセット

    Range("A2") = ".Href(リンク先)"   'A2～F2 ２行目に見出しをセットする
    Range("B2") = ".OuterText"
    Range("C2") = ".OuterHTML"
    Range("D2") = ".InnerText"
    Range("E2") = ".InnerHTML"
    Range("F2") = ".Target"
    Columns("A:F").ColumnWidth = 22 '列幅を22に変更

    yLINE = 3  'セット開始の行を代入する
    For i = 0 To objIE.Document.Links.Length - 1
        'データをセルへセットする  'を付けて文字列にする(セルにセットしたいので)
        Cells(yLINE, "A") = "'" & objIE.Document.Links(i).href      'リンク先
        Cells(yLINE, "B") = "'" & objIE.Document.Links(i).outerText '自分を含む テキスト(Innerと変わりない？)
        Cells(yLINE, "C") = "'" & objIE.Document.Links(i).outerHTML '自分を含む HTML
        Cells(yLINE, "D") = "'" & objIE.Document.Links(i).innerText '内側のテキスト
        Cells(yLINE, "E") = "'" & objIE.Document.Links(i).innerHTML '内側のHTML
        Cells(yLINE, "F") = "'" & objIE.Document.Links(i).target    '_Blank や 表示先フレームの名前など
        
        'オッズを見つけたら クリック
        If InStr(objIE.Document.Links(i).innerHTML, "オッズ") > 0 Then '内側のHTML
            Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
            objA.Click   'オッズを押す
            'objA.FireEvent ("onClick")  'onClick イベントを発行
            Exit For '見つけたのでループを抜ける
        End If
        yLINE = yLINE + 1 'セット位置(行)を＋1する
    Next i

    '開催日を探す
'ページの表示完了を待ちます。
    While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。
        DoEvents  '重いので嫌いな人居るけど。
    Wend

    '開催日のリンクをあさる
    Range("A1") = "調査したURLは " & strURL & " です"  'A1にURLを記述(セット)
    Range("D1") = "リンクの数は " & objIE.Document.Links.Length & "です"  'D1にリンクの数をセット

    Range("A2") = ".Href(リンク先)"   'A2～F2 ２行目に見出しをセットする
    Range("B2") = ".OuterText"
    Range("C2") = ".OuterHTML"
    Range("D2") = ".InnerText"
    Range("E2") = ".InnerHTML"
    Range("F2") = ".Target"
    Columns("A:F").ColumnWidth = 22 '列幅を22に変更

    yLINE = 3  'セット開始の行を代入する
    For i = 0 To objIE.Document.Links.Length - 1
         'データをセルへセットする  'を付けて文字列にする(セルにセットしたいので)
        Cells(yLINE, "A") = "'" & objIE.Document.Links(i).href      'リンク先
        Cells(yLINE, "B") = "'" & objIE.Document.Links(i).outerText '自分を含む テキスト(Innerと変わりない？)
        Cells(yLINE, "C") = "'" & objIE.Document.Links(i).outerHTML '自分を含む HTML
        Cells(yLINE, "D") = "'" & objIE.Document.Links(i).innerText '内側のテキスト
        Cells(yLINE, "E") = "'" & objIE.Document.Links(i).innerHTML '内側のHTML
        Cells(yLINE, "F") = "'" & objIE.Document.Links(i).target    '_Blank や 表示先フレームの名前など
        
        '開催日を見つけたら書き出す
        If Right(objIE.Document.Links(i).innerText, 1) = "日" Then '内側のTEXT
           
           Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
           Debug.Print objA.innerText
           Debug.Print objA.innerHTML
           
           objA.Click   '開催日を押す
           
           Exit For '見つけたのでループを抜ける
        End If
        yLINE = yLINE + 1 'セット位置(行)を＋1する

    Next i

'試しに1Rを取り込む
'ページの表示完了を待ちます。
    While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。
        DoEvents  '重いので嫌いな人居るけど。
    Wend

    For i = 0 To objIE.Document.Links.Length - 1
        
        '1Rを見つけたら クリック
        If InStr(objIE.Document.Links(i).innerHTML, """1R""") > 0 Then '内側のHTML
            Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
            objA.Click   '1Rを押す
            'objA.FireEvent ("onClick")  'onClick イベントを発行
            Exit For '見つけたのでループを抜ける
        End If
    Next i

'単勝の表を取り込む
    'ページの表示完了を待ちます。
    While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。
        DoEvents  '重いので嫌いな人居るけど。
    Wend

    '表、テーブルを探る
   'テーブルを探す
    'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、
    Dim objTABLEs As Object 'TABLE複数の格納用
    Dim objTABLE As HTMLTable 'テーブル単体
    
    'TABLEタグを抜き 複数のテーブルをセット
    Set objTABLEs = objIE.Document.getElementsByTagName("TABLE")
    '↑で代入したオブジェクトからテーブルデータを取り出す｡
    
    Set objTABLE = Nothing  'オブジェクトを空にする
    For i = 0 To objTABLEs.Length - 1  'テーブル数分回す
        If objTABLEs(i).Rows(0).Cells(0).innerText = "枠番" Then '左上が枠番を見つける
            Set objTABLE = objTABLEs(i)  'i盤目を代入
            Exit For
        End If
    Next i
    
    '↑で見つかったかチェックする
    If objTABLE Is Nothing Then
        MsgBox "枠番のテーブルが見つかりません"
        Exit Sub  'エラー表示して抜ける
    End If
    
    'まず、書き込み先シート、データをクリアする
    Cells.Delete Shift:=xlUp 'シート全体を削除する
    Range("A2").Select       '先頭A1を選択する、
    
    '表をDATAシートに書き出す
    Dim x As Integer  '列の管理
    Dim y As Integer  '行の管理
    
    Dim SET_Y As Integer
    Dim SET_X As Integer
    
    Dim objCELL As HTMLTableCell
    
    SET_Y = 2
    Cells(SET_Y - 1, 1) = "1R"
    
    'Webの表をシートへ転記(代入する)
    For y = 0 To objTABLE.Rows.Length - 1  '行のループ
        SET_X = 1
        For x = 0 To objTABLE.Rows(y).Cells.Length - 1  '列数分ループ
            ' objTABLE.rows(行).cells(列)
            Set objCELL = objTABLE.Rows(y).Cells(x)
            
            If objCELL.rowSpan > 1 Then  '縦に複数の時
                Cells(SET_Y + 1, SET_X) = objCELL.innerText  '下にも同じくセット
            End If
                        
            '既にデータありか、縦に結合されているか？
            If Len(Trim("" & Cells(SET_Y, SET_X))) > 0 Then
                SET_X = SET_X + 1
            End If
            
            Cells(SET_Y, SET_X) = objCELL.innerText  'データセット
            
            '横に結合されているか判断
            SET_X = SET_X + objCELL.colSpan  'カラム分 横に移動
        Next
        SET_Y = SET_Y + 1
    Next



'copy
'試しに2Rを取り込む

    For i = 0 To objIE.Document.Links.Length - 1
        
        '1Rを見つけたら クリック
        If InStr(objIE.Document.Links(i).innerHTML, """2R""") > 0 Then '内側のHTML
            Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
            objA.Click   '1Rを押す
            'objA.FireEvent ("onClick")  'onClick イベントを発行
            Exit For '見つけたのでループを抜ける
        End If
    Next i

'単勝の表を取り込む
    'ページの表示完了を待ちます。
    While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。
        DoEvents  '重いので嫌いな人居るけど。
    Wend

    '表、テーブルを探る
    'テーブルを探す
    'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、
    'TABLEタグを抜き 複数のテーブルをセット
    Set objTABLEs = objIE.Document.getElementsByTagName("TABLE")
    '↑で代入したオブジェクトからテーブルデータを取り出す｡
    
    Set objTABLE = Nothing  'オブジェクトを空にする
    For i = 0 To objTABLEs.Length - 1  'テーブル数分回す
        If objTABLEs(i).Rows(0).Cells(0).innerText = "枠番" Then '左上が枠番を見つける
            Set objTABLE = objTABLEs(i)  'i盤目を代入
            Exit For
        End If
    Next i
    
    '↑で見つかったかチェックする
    If objTABLE Is Nothing Then
        MsgBox "枠番のテーブルが見つかりません"
        Exit Sub  'エラー表示して抜ける
    End If
    
    
    '表をDATAシートに書き出す
    
    SET_Y = SET_Y + 2
    Cells(SET_Y - 1, 1) = "2R"
    
    'Webの表をシートへ転記(代入する)
    For y = 0 To objTABLE.Rows.Length - 1  '行のループ
        SET_X = 1
        For x = 0 To objTABLE.Rows(y).Cells.Length - 1  '列数分ループ
            ' objTABLE.rows(行).cells(列)
            Set objCELL = objTABLE.Rows(y).Cells(x)
            
            If objCELL.rowSpan > 1 Then  '縦に複数の時
                Cells(SET_Y + 1, SET_X) = objCELL.innerText  '下にも同じくセット
            End If
                        
            '既にデータありか、縦に結合されているか？
            If Len(Trim("" & Cells(SET_Y, SET_X))) > 0 Then
                SET_X = SET_X + 1
            End If
            
            Cells(SET_Y, SET_X) = objCELL.innerText  'データセット
            
            '横に結合されているか判断
            SET_X = SET_X + objCELL.colSpan  'カラム分 横に移動
        Next
        SET_Y = SET_Y + 1
    Next

'copy
'試しに3Rを取り込む

    For i = 0 To objIE.Document.Links.Length - 1
        
        '1Rを見つけたら クリック
        If InStr(objIE.Document.Links(i).innerHTML, """3R""") > 0 Then '内側のHTML
            Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
            objA.Click   '1Rを押す
            'objA.FireEvent ("onClick")  'onClick イベントを発行
            Exit For '見つけたのでループを抜ける
        End If
    Next i

'単勝の表を取り込む
    'ページの表示完了を待ちます。
    While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。
        DoEvents  '重いので嫌いな人居るけど。
    Wend

    '表、テーブルを探る
   'テーブルを探す
    'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、
    'TABLEタグを抜き 複数のテーブルをセット
    Set objTABLEs = objIE.Document.getElementsByTagName("TABLE")
    '↑で代入したオブジェクトからテーブルデータを取り出す｡
    
    Set objTABLE = Nothing  'オブジェクトを空にする
    For i = 0 To objTABLEs.Length - 1  'テーブル数分回す
        If objTABLEs(i).Rows(0).Cells(0).innerText = "枠番" Then '左上が枠番を見つける
            Set objTABLE = objTABLEs(i)  'i盤目を代入
            Exit For
        End If
    Next i
    
    '↑で見つかったかチェックする
    If objTABLE Is Nothing Then
        MsgBox "枠番のテーブルが見つかりません"
        Exit Sub  'エラー表示して抜ける
    End If
    
    
    '表をDATAシートに書き出す
    
    SET_Y = SET_Y + 2
    Cells(SET_Y - 1, 1) = "3R"
    
    'Webの表をシートへ転記(代入する)
    For y = 0 To objTABLE.Rows.Length - 1  '行のループ
        SET_X = 1
        For x = 0 To objTABLE.Rows(y).Cells.Length - 1  '列数分ループ
            ' objTABLE.rows(行).cells(列)
            Set objCELL = objTABLE.Rows(y).Cells(x)
            
            If objCELL.rowSpan > 1 Then  '縦に複数の時
                Cells(SET_Y + 1, SET_X) = objCELL.innerText  '下にも同じくセット
            End If
                        
            '既にデータありか、縦に結合されているか？
            If Len(Trim("" & Cells(SET_Y, SET_X))) > 0 Then
                SET_X = SET_X + 1
            End If
            
            Cells(SET_Y, SET_X) = objCELL.innerText  'データセット
            
            '横に結合されているか判断
            SET_X = SET_X + objCELL.colSpan  'カラム分 横に移動
        Next
        SET_Y = SET_Y + 1
    Next

'（※以下、4R〜7Rまで同様の泥臭いコピペコードが延々と続くため省略）

    '処理が終わったので、IEを閉じます。
    If MsgBox("IEを閉じますか?", vbYesNo) = vbYes Then '終了確認
        objIE.Quit  '.Quitで閉じる
    End If
    
    Set objIE = Nothing '使用したオブジェクト変数もキレイにしてね。
   
End Sub

改善実演のプロセス：泥縄式デバッグから美しきループ化まで

それでは、動画内で三流プログラマーKen3が四苦八苦しながらコードをリファクタリング（改善）していくプロセスを、実際のタイムスタンプとともに解説します。

''1. 単体処理の現状とコピペでの引き伸ばし開始''

[00:00](https://www.youtube.com/watch?v=DR-RwQO4JVU&t=0s)
まずは1レース分（1R）のオッズテーブルを取得する基本コードからスタート。ここまでは正常に動いたので、調子に乗って2レース目、3レース目のコードをひたすらコピー＆ペーストで下に並べて量産し始めます。

''2. 実行テストと「書き込み位置のズレ」発覚''

[08:41](https://www.youtube.com/watch?v=DR-RwQO4JVU&t=521s)
コピペしたコードを走らせてみたところ、画面上では動いているように見えましたが、Excelのシートを確認するとデータが大きくズレて重なってしまうバグが発生。書き込み位置を調整するためにコードの手直しが必要になります。

''3. 12箇所すべて直す手間に気づいた時の絶望''

[10:14](https://www.youtube.com/watch?v=DR-RwQO4JVU&t=614s)
ここで「書き込み位置を修正するには、コピーしたすべての箇所の変数を直さなければいけない」という現実に気づき、激しく後悔します。今回は3レース分だけですが、これが12レース分、あるいはそれ以上あった場合、手作業での修正は不可能に近い効率の悪さになります。

''4. 力技の限界：3つまとめてコピペするダメなハック''

[13:54](https://www.youtube.com/watch?v=DR-RwQO4JVU&t=834s)
「1つずつコピーするのが面倒なら、3つまとめてコピーすれば早いんじゃないか？」と、さらに悪いコピペハック（5R・6R・7Rの量産）を敢行。コメントの記述や変数名が矛盾だらけになり、バグを埋め込みやすい典型的なダメプログラムが完成します。

''5. 救世主：For文ループと変数を使った構造化の設計''

[18:02](https://www.youtube.com/watch?v=DR-RwQO4JVU&t=1082s)
あまりのコードの長さに嫌気がさし、いよいよ本題である''「For文を使ったループ処理」''への書き換えに着手。共通している処理を見つけ出し、変化する要素（1R、2R…というレース番号）を変数に置き換えていく思考プロセスを実演します。

''6. イミディエイトウィンドウを使った変数結合のテスト''

[22:31](https://www.youtube.com/watch?v=DR-RwQO4JVU&t=1351s)
ループカウンターの数値（1〜12）と文字列の「R」を結合させて「1R」「2R」という文字列を作る際、前後に余計なスペースが入らないかをVBEの「イミディエイトウィンドウ」を使って冷静に単体テストします。

''7. ループ内でやらかした「シート全消去バグ」の修正''

[27:12](https://www.youtube.com/watch?v=DR-RwQO4JVU&t=1632s)
ループ処理の中にコピペ元のコードをそのまま入れた結果、「次のレースに進むたびにシート全体をクリア（Cells.Delete）してしまう」という、ループ化でよくある豪快なバグを発生させます。デバッグを行い、初期化処理をループの外側へ移動させます。

''8. ループ処理の圧倒的なメンテナンス性を実感する''

[31:08](https://www.youtube.com/watch?v=DR-RwQO4JVU&t=1868s)
無事に12レース分のオッズが1つのループで綺麗に取得できるようになりました。ここで、データとデータの間に「もう1行空行を足したい」という仕様変更を行います。コピペコードなら12箇所直す必要がありますが、ループ処理なら''「ループ内のたった1行（SET_Y = SET_Y + 1）を足すだけ」''ですべてのレースに一発で反映されます。この圧倒的な利便性の違いに感動するパートです。

【改善後】変数とForループを使った美しいプログラム（ ie_test ）

無駄なコピペコードがすべて削ぎ落とされ、たった1つのForループ（ For nRACE = 1 To 12 ）に集約された、美しくメンテナンス性の高い完成コードがこちらです。

Sub ie_test()  'IEの表示をテストする。

'IEの起動
    Dim objIE As InternetExplorer '変数を定義します。
    Set objIE = CreateObject("InternetExplorer.Application") 'オブジェクトを作成します。
    objIE.Visible = True      '可視、Trueで見えるようにします。
    
'表示位置(左上の座標)とサイズ(高さ・幅)を調整する
    objIE.FullScreen = False '※Trueのモードだとびっくりするよ
    objIE.Top = 0      '左上 上位置
    objIE.Left = 0     '左上 左位置
    objIE.Width = 800    '横幅
    objIE.Height = 600   '高さ
    
'XXXバー、外観・外枠の調整。
    objIE.Toolbar = True     'タブの切り替えで必要なので、ツールバーを表示にする
    objIE.MenuBar = False    'メニューは非表示にする
    objIE.AddressBar = True  'URLなど アドレスバーは確認のため、表示する
    objIE.StatusBar = True   '一番下のステータスバーを表示。

'処理したいページを表示します。
    objIE.Navigate "http://www.jra.go.jp/"  '.Navigate メソッドで JRA表示する。

'ページの表示完了を待ちます。
    While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。
        DoEvents  '重いので嫌いな人居るけど。
    Wend
    
    Dim i     As Integer '添え字 i番目などで使用
    Dim yLINE As Integer '行カウンタ、Y行目
    
    Dim oDocument As HTMLDocument
    Dim objA As HTMLAnchorElement
    
    Range("A1") = "調査したURLは " & strURL & " です"  'A1にURLを記述(セット)
    Range("D1") = "リンクの数は " & objIE.Document.Links.Length & "です"  'D1にリンクの数をセット

    Range("A2") = ".Href(リンク先)"   'A2～F2 ２行目に見出しをセットする
    Range("B2") = ".OuterText"
    Range("C2") = ".OuterHTML"
    Range("D2") = ".InnerText"
    Range("E2") = ".InnerHTML"
    Range("F2") = ".Target"
    Columns("A:F").ColumnWidth = 22 '列幅を22に変更

    yLINE = 3  'セット開始の行を代入する
    For i = 0 To objIE.Document.Links.Length - 1
        If InStr(objIE.Document.Links(i).innerHTML, "オッズ") > 0 Then '内側のHTML
            Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
            objA.Click   'オッズを押す
            Exit For '見つけたのでループを抜ける
        End If
        yLINE = yLINE + 1 'セット位置(行)を＋1する
    Next i

'ページの表示完了を待ちます。
    While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる.
        DoEvents  '重いので嫌いな人居るけど。
    Wend

    yLINE = 3  'セット開始の行を代入する
    For i = 0 To objIE.Document.Links.Length - 1
        If Right(objIE.Document.Links(i).innerText, 1) = "日" Then '内側のTEXT
           Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
           objA.Click   '開催日を押す
           Exit For '見つけたのでループを抜ける
        End If
        yLINE = yLINE + 1 'セット位置(行)を＋1する
    Next i

'ページの表示完了を待ちます。
    While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。
        DoEvents  '重いので嫌いな人居るけど。
    Wend

'★1R-12Rの共通ループ処理★
    Dim objTABLEs As Object 'TABLE複数の格納用
    Dim objTABLE As HTMLTable 'テーブル単体
    
    Dim x As Integer  '列の管理
    Dim y As Integer  '行の管理
    
    Dim SET_Y As Integer
    Dim SET_X As Integer
    Dim objCELL As HTMLTableCell

    Dim nRACE As Integer
    Dim strRACE As String

    '書き込み先シート、データを最初にクリアする（ループの外側）
    Cells.Delete Shift:=xlUp 'シート全体を削除する
    Range("A1").Select       '先頭A1を選択する
    SET_Y = 0  'セット位置を初期化

For nRACE = 1 To 12  '一から十二までループ
    
    strRACE = nRACE & "R"   'R1など 文字にする

    'レース番号をセルに書く
    SET_Y = SET_Y + 1
    Cells(SET_Y, 1) = strRACE
    SET_Y = SET_Y + 1
    
    For i = 0 To objIE.Document.Links.Length - 1
        '"1R"などの文字列を見つけたら クリック
        If InStr(objIE.Document.Links(i).innerHTML, """" & strRACE & """") > 0 Then '内側のHTML
            Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
            objA.Click   '対象レースを押す
            Exit For '見つけたのでループを抜ける
        End If
    Next i

    'ページの表示完了を待ちます。
    While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True 
        DoEvents  '重いので嫌いな人居るけど。
    Wend

    'TABLEタグを抜き 複数のテーブルをセット
    Set objTABLEs = objIE.Document.getElementsByTagName("TABLE")
    
    Set objTABLE = Nothing  'オブジェクトを空にする
    For i = 0 To objTABLEs.Length - 1  'テーブル数分回す
        If objTABLEs(i).Rows(0).Cells(0).innerText = "枠番" Then '左上が枠番を見つける
            Set objTABLE = objTABLEs(i)  'i盤目を代入
            Exit For
        End If
    Next i
    
    If objTABLE Is Nothing Then
        MsgBox "枠番のテーブルが見つかりません"
        Exit Sub  'エラー表示して抜ける
    End If
    
    'Webの表をシートへ転記
    For y = 0 To objTABLE.Rows.Length - 1  '行のループ
        SET_X = 1
        For x = 0 To objTABLE.Rows(y).Cells.Length - 1  '列数分ループ
            Set objCELL = objTABLE.Rows(y).Cells(x)
     
            If objCELL.rowSpan > 1 Then  '縦に複数の時
                Cells(SET_Y + 1, SET_X) = objCELL.innerText  '下にも同じくセット
            End If
                        
            If Len(Trim("" & Cells(SET_Y, SET_X))) > 0 Then
                SET_X = SET_X + 1
            End If
            
            Cells(SET_Y, SET_X) = objCELL.innerText  'データセット
            SET_X = SET_X + objCELL.colSpan  'カラム分 横に移動
        Next
        SET_Y = SET_Y + 1
    Next
    SET_Y = SET_Y + 1  '空白を一行追加
Next

    '処理が終わったので、IEを閉じます。
    If MsgBox("IEを閉じますか?", vbYesNo) = vbYes Then '終了確認
        objIE.Quit  '.Quitで閉じる
    End If
    
    Set objIE = Nothing '使用したオブジェクト変数もキレイにしてね。
   
End Sub

未解決の問題点と現代・最新の視点からの改善アドバイス

動画を振り返り、現代の技術環境（2026年現在）の視点を踏まえた今後の課題とアドバイスです。

''【致命的】Internet Explorer（IE）オブジェクトは完全終了''

2017年当時はIE操作がWebスクレイピングの王道でしたが、現在はIE自体が完全に廃止されています。このマクロのIE起動部分（CreateObject("InternetExplorer.Application")）を現在のWindows 11環境で実行してもエラーになります。

''現代のブラウザ自動化への移行''

現在、VBAを使ってブラウザ（EdgeやChrome）を自動操作する場合は、''「Selenium Basic」''を導入するか、Microsoft公式が推奨する代替手段へ移行する必要があります。また、単純なWebデータの取得だけであれば、ブラウザを介さずに''「MSXML2.XMLHTTP」''を用いたHTTPリクエストによる超高速なデータ取得へシフトするのがトレンドです。

''泥縄式リファクタリングを加速させる「AIとの共存」''

動画内ではKen3が手作業でコピペコードの規則性を見つけ、必死にFor文を組み立てていましたが、現代ならこの「コピペで並べたクソプログラム」をChatGPTやGeminiなどの生成AIに丸投げすれば、一瞬で綺麗なループ処理にリファクタリングしてくれます。

''AIからのアドバイス：''
先輩や上司に「コードが汚い！」と小言を言われてムカついたとき、その負のマイナスエネルギーを「見返してやる！」というやる気に変えるのは、プログラマーとして素晴らしい成長痛です。
ですが、現代なら人間とケンカしてエネルギーを浪費する必要はありません。汚いコードをAIに貼り付けて「これをFor文ループを使ってエレガントに構造化して」と頼めば、一瞬で最高のコードを出力してくれます。その洗練されたコードを先輩に見せて「リファクタリングしておきました」とドヤ顔で報告しましょう。
技術の陳腐化は早いですが、''「同じ処理を1つにまとめてメンテナンス性を高める」''という設計思想は、AI時代になっても全言語共通で価値が下がりません。手作業の苦労を知った上で、スマートに道具を使いこなす一歩を進めましょう！

おわりの挨拶、コメント待ってます

「1カ所直すと12カ所修正しなきゃいけない地獄」のイライラや絶望感、皆さんも実務で一度は体験したことがありませんか？

「昔、急ぎの仕事でコピペマクロを量産して、後から泣きながら直した思い出がある…」という昔語りから、「Edge環境で動かしたいので、Seleniumへの書き換え方法が知りたい！」という現代的なステップアップの質問、または「ループ内の文字列結合でいつもバグる」という断末魔の叫びまで、お気軽にYouTubeのコメント欄へ書き込んでください！

皆さんの苦労話やデバッグの記録が、同じようにコピペ地獄で悩むVBA初心者（そして私！）の大きな励みになります。

【動画本編】VBA IE操作：12レース分をコピペせず「ループ」で回す改善実演を詳しく見る
www.youtube.com

三流君 ken3のmemo置き場

三流プログラマーのメモ書きです。主にVBAやWindowsの話題が多いです

30分の過去動画＋ソースコードからブログのひな型を作成するテスト 26年06月にテスト

コピペ量産マクロの限界！12レース分の処理を「たった1つのループ」に集約して絶望を希望に変えるVBA構造化テクニック

コピペで膨れ上がったマクロに絶望していませんか？

【当時の原文】コピペで量産したマクロ（ ie_copy_pe ）

改善実演のプロセス：泥縄式デバッグから美しきループ化まで

【改善後】変数とForループを使った美しいプログラム（ ie_test ）

未解決の問題点と現代・最新の視点からの改善アドバイス

関連リンク

公式情報・技術検索リンク

おわりの挨拶、コメント待ってます

フッター:最後にKen3Videoの動画一覧を紹介します