ランキング１~30位をシートのA列に転記したい

質問

ヤフーのデイリーランキング
http://searchranking.yahoo.co.jp/burst_ranking/
の　１位から３０位の言葉をエクセルのシートA列に転記するVBAはどのような記述に
なりますか？

IEで開くところまではできましたが　それからさきがさっぱりです。

ソースをみると　li　タグのなかの　さらに　a　タグで囲まれているようですが
どうしてよいかわかりません。

途中までスクリプト記述してみました。

--------------------------------------------------------------------
Sub 急上昇ワード()

Dim objIE As InternetExplorer
Set objIE = CreateObject("Internetexplorer.Application")ト

objIE.Visible = True

Dim strUrl As String '次ページのURL
strUrl = "http://searchranking.yahoo.co.jp/burst_ranking/"

objIE.navigate strUrl

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

Dim htmlDoc As HTMLDocument
Set htmlDoc = objIE.document

回答No.1

imogasi · ベストアンサー

この種のものに余り経験を積んでないので、下記は最適といえないかもしれないが、参考に。
小生はこのサイトの内容のことも全く知りませんが。
このＷＥＢサイトの場合にしか使えない、また仕様を変えられると、全くダメになる
ものだが。ＷＥＢサイトをＶＢＡで扱うというのは、こういうあやふやなところがあるのかも。
標準モジュールに
'＝＝＝＝＝＝＝ＷＥＢのソースから抜出
Sub test03()
Dim objIE As Object 'InternetExplorer
Set objIE = CreateObject("Internetexplorer.Application")

objIE.Visible = True

Dim strUrl As String '次ページのURL
strUrl = "http://searchranking.yahoo.co.jp/burst_ranking/"

objIE.navigate strUrl

Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE
DoEvents
Loop
objIE.Visible = True
'----
Dim htmlDoc As Object 'HTMLDocument
Set htmlDoc = objIE.Document
k = 1
'タグ(Item)の数(要素の数)は.Countじゃなくて.Lengthです.配列も０から始まる。
'i=0から初めて、.Length - 1までのループとしてます

For i = 0 To objIE.Document.All.Length - 1
'XXXX = "'" & objIE.Document.All(i).InnerTEXT
'MsgBox XXXX
XXXX = "'" & objIE.Document.All(i).InnerHTML
Worksheets("Sheet1").Cells(k, "A") = XXXX　'エクセルのＳｈｅｅｔ１に出している。
k = k + 1
Next i
End Sub
’＝＝＝＝＝＝＝Ｓｈｅｅｔ１から必要なデータを抜き出して整理
Sub test04()
'Sheet1に元データ
'Sheet3のＡ，Ｂ，Ｃ列に順位順データ書き出し
k = 1 'Sheet3での最初の書き出し行番号
'－－
For i = 1 To 20 '20位？まで探すことにしたもの
Set x = Worksheets("Sheet1").Range("A1:A400").Find(what:=i, lookat:=xlWhole)
' MsgBox x.Row
Worksheets("Sheet3").Cells(k, "A") = Worksheets("Sheet1").Cells(x.Row, "A")
Worksheets("Sheet3").Cells(k, "B") = Worksheets("Sheet1").Cells(x.Row + 1, "A") '次行
Worksheets("Sheet3").Cells(k, "C") = Worksheets("Sheet1").Cells(x.Row + 2, "A") '次々行
k = k + 1
Next i
End Sub
ーーー
順位の表部分はテーブルやリストではない様ですが。
順位はただの順位数字があるもののように見えた。
ーーー
参考までに、エクセルの機能で、表にまとめられたＷＥＢ記事は「ＷＥＢクエリ」という抜出し機能を使える場合がある。
＝＝
結果　Ｓｈｅｅｔ３
１月１４日現在
1 15371202点 池田大
2 365938点 伊藤千晃
3 365323点 ご注意!!officeのプロダクトキーが不正コピーされています。
4 134054点 河中あい
5 128382点 ドン 由来
6 101910点 石川涼
7 69929点 セカオワ 結婚
8 45799点 Saori
9 40820点 セッチマはみがき スペシャル
10 38874点 桑田真澄 息子
11 32490点 三浦友和 報知映画賞
12 19026点 DAIGO インスタ
13 17697点 かけすぎ部
14 16936点 藪下里美
15 15723点 太陽クラブ
16 15426点 Nakajin
17 12988点 日野未来
18 10330点 その時チャンスは舞い降りた! キーワード
19 10166点 代々木上原 おこん
20 9417点 袴田吉彦 浮気相手

お礼

回答ありがとうございました。　参考になりました。