こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

ヤフーのデイリーランキング
http://searchranking.yahoo.co.jp/burst_ranking/
の 1位から30位の言葉をエクセルのシート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

投稿日時 - 2017-01-13 22:22:03

QNo.9280872

困ってます

質問者が選んだベストアンサー

この種のものに余り経験を積んでないので、下記は最適といえないかもしれないが、参考に。
小生はこのサイトの内容のことも全く知りませんが。
このWEBサイトの場合にしか使えない、また仕様を変えられると、全くダメになる
ものだが。WEBサイトをVBAで扱うというのは、こういうあやふやなところがあるのかも。
標準モジュールに
'=======WEBのソースから抜出
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です.配列も0から始まる。
'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 'エクセルのSheet1に出している。
k = k + 1
Next i
End Sub
’=======Sheet1から必要なデータを抜き出して整理
Sub test04()
'Sheet1に元データ
'Sheet3のA,B,C列に順位順データ書き出し
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
ーーー
順位の表部分はテーブルやリストではない様ですが。
順位はただの順位数字があるもののように見えた。
ーーー
参考までに、エクセルの機能で、表にまとめられたWEB記事は「WEBクエリ」という抜出し機能を使える場合がある。
==
結果 Sheet3
1月14日現在
115371202点池田大
2365938点伊藤千晃
3365323点ご注意!!officeのプロダクトキーが不正コピーされています。
4134054点河中あい
5128382点ドン 由来
6101910点石川涼
769929点セカオワ 結婚
845799点Saori
940820点セッチマはみがき スペシャル
1038874点桑田真澄 息子
1132490点三浦友和 報知映画賞
1219026点DAIGO インスタ
1317697点かけすぎ部
1416936点藪下里美
1515723点太陽クラブ
1615426点Nakajin
1712988点日野未来
1810330点その時チャンスは舞い降りた! キーワード
1910166点代々木上原 おこん
209417点袴田吉彦 浮気相手

投稿日時 - 2017-01-14 22:30:24

お礼

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

投稿日時 - 2017-10-09 17:56:37

ANo.1

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問