Sub Webページの内容を抽出する_ヤフーニュース一覧()
    
    'IEを開く ※Windows11ではIEがないので使えません
    Set ブラウザ = CreateObject("InternetExplorer.Application")
    
        ブラウザ.Visible = False 'ブラウザ見せない、trueで見える
        
        ブラウザ.Navigate "https://news.yahoo.co.jp/topics" 'ヤフーニュース開く
    
    Do While ブラウザ.busy = True Or _
             ブラウザ.readyState < READYSTATE_COMPLETE 'ページ読込完了まで待つ
        DoEvents '処理を念の為、追加で待つ
    Loop
    
    行 = 1
    列 = 1
    
    For Each 内容 In ブラウザ.Document.getElementsByTagName("a") 'aのタグ情報を取得する

        Cells(行, 列) = 内容.innerText '取得したデータを貼り付ける
                
        列 = 列 + 1 'どんどん右へ移動
        
        If 列 > 10 Then '10列目で折り返す
            列 = 1
            行 = 行 + 1
        End If
    
    Next
    
    ブラウザ.Quit 'ブラウザ閉じる
    
    Set 内容 = Nothing
    Set ブラウザ = Nothing

    Rows("12:16").Delete '見栄えを整える
    Rows("1:3").Delete
    Columns("A").Delete
    
    Cells.WrapText = False '右で折り返すを解除
    Columns("A:I").AutoFit '列幅を整える

End Sub