あんま複雑じゃないやつ

なんかいい題材ないかなーと、さ迷っていたら将棋連盟のサイトにまいにち詰将棋というコーナーがあるのを知った。

日本将棋連盟のまいにち詰将棋のページです。日本将棋連盟は伝統文化としての将棋の普及発展と技術向上や将棋を通じた交流親善などを目的とした公益社団法人です。

これの右のメニューのところの手数のリンクはこのまいにち詰将棋のカテゴリ分けされているわけではなく、また別物で、まいにち詰将棋自体は特に整理されているわけではなさ気な感じだった。これをいい感じに検索できるサイトとかどうかなーと思ったので挑戦してみる。

スクレイピング

とりあえず今ある詰将棋を集めてデータを作る。今自分にできるのはVBA+IEでのスクレイピングなので、それ使ってデータを収集する。

Sub getdata()

    Dim objIE As InternetExplorer
    Set objIE = CreateObject("Internetexplorer.Application")
    
    objIE.Visible = True
    objIE.navigate "https://www.shogi.or.jp/tsume_shogi/everyday/"
    
    Do While objIE.Busy = True Or objIE.readyState <> 4
    DoEvents
    Loop
    
    Dim htmldoc As HTMLDocument
    Set htmldoc = objIE.document
    
    Call scrape(htmldoc)
    
    Dim lastpg As Long
    lastpg = 103
    
    For i = 2 To lastpg
        objIE.navigate "https://www.shogi.or.jp/tsume_shogi/everyday/index_" & i & ".html"

        Do While objIE.Busy = True Or objIE.readyState <> 4
        DoEvents
        Loop

        Set htmldoc = objIE.document

        Call scrape(htmldoc)

    Next i

End Sub
Function scrape(ByVal doc As HTMLDocument)
    
    
    Dim ul As IHTMLElementCollection
    Set ul = doc.getElementsByClassName("floatListA01Col3-30 indexListA01 fixHeight section04")
    
    Dim taga As IHTMLElementCollection
    Set taga = ul(0).getElementsByTagName("a")
    
    Dim tagp As IHTMLElementCollection
    Set tagp = ul(0).getElementsByTagName("p")
    
    For i = 0 To 11
        Dim lr As Long
        lr = ThisWorkbook.Sheets("data").Cells(Rows.Count, 1).End(xlUp).Row
    
        ThisWorkbook.Sheets("data").Range("A" & lr + 1).Value = tagp(i).innerText
        ThisWorkbook.Sheets("data").Range("B" & lr + 1).Value = taga(i).href
    Next i

End Function

こんな。最後のページでエラー出て止まるけど、とりあえず目的のデータを集めれた。