VBAでランキング上位30位のワードリストをエクセルに転記する方法

このQ&Aのポイント
  • ヤフーのデイリーランキングの上位30位の言葉をエクセルのシートA列に転記するVBAの記述方法を教えてください。
  • IEで指定したURLを開き、上位30位の言葉を取得するためには、HTML解析が必要です。
  • VBAでのHTML解析には、InternetExplorerとHTMLDocumentを使用し、liタグとaタグを組み合わせて上位30位の言葉を抽出します。
回答を見る
  • ベストアンサー

ランキング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

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

  • ベストアンサー
  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.1

この種のものに余り経験を積んでないので、下記は最適といえないかもしれないが、参考に。 小生はこのサイトの内容のことも全く知りませんが。 この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日現在 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点 袴田吉彦 浮気相手

ch20090926
質問者

お礼

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

関連するQ&A

  • メルカリ VBA 出品カテゴリのスクリプト

    https://www.mercari.com/jp/sell/ こちらのページをIE/VBA制御したいと考えております。 商品の詳細という欄にあるカテゴリのフォームは、 大カテゴリ(例: レディース)を入力すると、 スクリプトを読み込んで小カテゴリ(例: ワンピース)のフォームが出てくる仕組みになっています。 下記のように、フォームの要素を取得して、 フォームに レディース という文字列を出力することには成功したのですが、 新しいフォームの追加がされていません。 おそらくフォームに値を入れるだけでは、 スクリプトのトリガーを引いていないことが原因だと思うのですが、 どのようにすればスクリプトが動くか、または原因をどのように調べたら良いか、 ご教示頂けましたら幸いでございます。 何卒よろしくお願いいたします。 Sub test() Dim objIE As InternetExplorer 'IEオブジェクトを準備 Set objIE = CreateObject("Internetexplorer.Application") '新しいIEオブジェクトを作成してセット objIE.Visible = True 'IEを表示 objIE.navigate "https://www.mercari.com/jp/sell/" 'IEでURLを開く Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE '読み込み待ち DoEvents Loop Dim htmlDoc As HTMLDocument 'HTMLドキュメントオブジェクトを準備 Set htmlDoc = objIE.document 'objIEで読み込まれているHTMLドキュメントをセット Dim elForm As IHTMLElement, elPlaceholder1, elPlaceholder2 As IHTMLElement 'IHTMLElementオブジェクトを準備 Set elPlaceholder1 = htmlDoc.getElementsByClassName("select-default")(0) elPlaceholder1.selectedIndex = 1 End Sub

  • VBA IE制御 TABLE取得できません

    以下のコードを使用し、WEBページから「レース検索結果」のテーブルを取得しようとしました。 エラーは出ないのですがコード下から5行目で「OK」のメッセージボックスが 表示されるはずなのですが表示されませんでした。 ローカルウィンドウで確認したところ、summary「レース検索結果」が取得できていませんでした。 WEBページのソースには「レース検索結果」というsummaryは存在しているんですが・・・ どなたかご教授ねがいます OS:Windows 7 Excel:2007 InternetExplorer:11 Sub test() Const strURL As String = "http://db.netkeiba.com/?pid=race_search_detail" Dim objIE As New InternetExplorer Dim objDoc As HTMLDocument Dim objAllInput As Object Dim objInput As HTMLInputButtonElement Dim objAllTable As Object Dim objTable As HTMLTable With objIE .navigate strURL .Visible = True End With Do While objIE.Busy = True Or objIE.readyState <> 4 DoEvents Loop Set objDoc = objIE.document Set objAllInput = objDoc.getElementsByTagName("input") For Each objInput In objAllInput If objInput.ID = "check_Jyo_09" Then objInput.Checked = True Exit For End If Next Do While objIE.Busy = True Or objIE.readyState <> 4 DoEvents Loop For Each objInput In objAllInput If objInput.Value = "検索" Then objInput.Click Exit For End If Next Do While objIE.Busy = True Or objIE.readyState <> 4 DoEvents Loop Application.Wait (Now + TimeValue("00:00:10")) Set objDoc = objIE.document Set objAllTable = objDoc.getElementsByTagName("table") For Each objTable In objAllTable If objTable.Summary = "レース検索結果" Then MsgBox "OK" Exit For End If Next End Sub

  • DoEvents

    VBSでDoEventsは使えないのでしょうか? *************************** Dim ObjIE dim i Set ObjIE = CreateObject("InternetExplorer.Application") ObjIE.Navigate "http://oshiete.goo.ne.jp/" ObjIE.Visible = True Do While ObjIE.Busy = True DoEvents Loop Do While ObjIE.Document.ReadyState <> "complete" DoEvents Loop Set ObjIE = Nothing *************************** だと、エラーになりました。 Wscript.sleep 3000 ならエラーにならずにコードは動きました。 VBAならDoEventsは使えるのに VBSで使えない理由を教えてください。

  • 「地図」で検索するにはどういう操作をすればいいので

    ヤフーのトップページから 値を入れて検索を押すまではできるのですが 「ウェブ」ではなく「地図」で検索するにはどういう操作をすればいいのでしょうか? Sub yahoo() Dim objIE As Object Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.Navigate "http://www.yahoo.co.jp/" Do While objIE.Busy = True DoEvents Loop Do While objIE.Document.ReadyState <> "complete" DoEvents Loop objIE.Document.forms(0).elements("p").Value = "東京" '‘「地図」をクリックする操作をしたい objIE.Document.forms(0).submit Set objIE = Nothing End Sub 宜しくお願いいたします。

  • VBでのContinueが間違っているとき

    http://oshiete1.goo.ne.jp/qa4564345.htmlではありがとうございました。 教わったことを参考にやってみたのですがうまくいきません。 Continueの部分がうまくいくPCといかないPCがあるのでどうしたらいいか分からなくなってしまいました・・・ Option Explicit Dim objIE Dim objShell Dim objWindow Dim WinExist Dim strURL Dim strURL2 Dim Flug strURL = "http://www.yahoo.co.jp/" strURL2 = "http://www.google.co.jp/" WinExist = False Set objShell = CreateObject("Shell.Application") For Each objWindow In objShell.Windows If TypeName(objWindow.Document) <> "HTMLDocument" Then Continue End If WinExist = True Set objIE = objWindow If objIE.LocationURL = strURL Then Flug = True Exit For End If Next If Flug = True Then msgbox "ヤフー存在" Else msgbox "別の処理を行なう" If WinExist = False Then 'IEが無い場合 起動する Set objIE = WScript.CreateObject("InternetExplorer.Application") objIE.Navigate strURL2 objIE.Visible = True Set objIE = Nothing End If End If

  • サイトのソースのsubmitボタンの数を取得したい

    サイトのソースのsubmitボタンの数を取得したいのですが Sub test() Dim objIE As InternetExplorer Dim MyRow As Long Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.Navigate "http://www.coneco.net/" Do While objIE.Busy = True Or objIE.ReadyState <> 4 DoEvents Loop Debug.Print objIE.Document.all.tags("input").Type("submit").Count Set objIE = Nothing End Sub だとうまく動きません。 どう、変更すればよろしいですか?

  • 現在表示されているURLを取得したいのですが

    Sub test1() Dim objIE As InternetExplorer Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.Navigate "http://www.goo.ne.jp/" Do While objIE.Busy = True Or objIE.ReadyState <> 4 DoEvents Loop Debug.Print objIE.Navigate Set objIE = Nothing End Sub //////////////////////////////////////////////// をやろうとすると、 Debug.Print objIE.Navigate の部分で、「引数は省略できません。」とエラーになります。 どう修正すればいいか教えてください。 ("http://www.goo.ne.jp/"はダミーです)

  • EXCEL VBAで URLの内容 が取得できない

    EXCEL VBA で VBAサンプルを参考にして、下記により、URLの内容を得ようとしていますが、できません。 どうも、URL画面の中に インプット用の記述があると、できなくなるのでは、と推測していますが、できるケースもあるようです。解決方法があるようでしたら、教えていただけますでしょうか? (Win7 64B EXCEL2010 IE11です。)' Sub URL取得TEST() On Error GoTo Er1 Dim StrUrl As String StrUrl = InputBox("URLを指定", "URL入力", "http://www3.nhk.or.jp/nhkworld/") ' これは 読み込めます StrUrl = InputBox("URLを指定", "URL入力", "http://uwl.weblio.jp/") ' これが読み込めません Dim objIE As Object Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.FullScreen = False objIE.Top = 200 objIE.Left = 100 objIE.Width = 800 objIE.Height = 600 objIE.navigate StrUrl While (objIE.readyState <> 3 And objIE.readyState <> 4) Or objIE.busy = True DoEvents Wend DoEvents Workbooks.Add objIE.ExecWB 17, 0 objIE.ExecWB 12, 0 Sheets.Add ActiveSheet.name = "Format テキスト" Range("A1").Select ActiveSheet.PasteSpecial Format:="テキスト" objIE.ExecWB 17, 0 objIE.ExecWB 12, 0 Sheets.Add ActiveSheet.name = "FormatHTML" Range("A1").Select ActiveSheet.PasteSpecial Format:="HTML" '別のURLでテキストOKでこれはだめというケースあり ' objIE.Quit Set objIE = Nothing Exit Sub ' Er1: objIE.Quit Set objIE = Nothing End Sub

  • IEを探すプログラムがうまくいきません。

    VBScriptで指定するサイトが開いていなかった場合とある処理を行い、とあるサイトが開いていれば別の処理をし終了させることをやっていますがうまくいきません。 自分の考えとしては 1・開いているIEをくるくるループ回して探す 2・その中にヤフーがあればフラグをTrue処理   それ以外はFalse処理 これだけで終わりにしたいのですが・・・ Dim objIE Dim objShell Dim objWindow Dim WinExist Dim strURL Dim Flug Dim strURL2 strURL = "http://www.yahoo.co.jp/" strURL2 = "http://www.google.co.jp/" 'IEが起動して無い場合プログラムが起動しないのでダミー立ち上げ Set objIE = WScript.CreateObject("InternetExplorer.Application") objIE.Navigate "about:blank" objIE.Visible = True Set objIE = Nothing WinExist = False Set objShell = CreateObject("Shell.Application") For Each objWindow In objShell.Windows If TypeName(objWindow.Document) = "HTMLDocument" Then WinExist = True Set objIE = objWindow End If Next If objIE.LocationURL = strURL Then Flug = True Else If objIE.LocationURL <> strURL Then Flug = False Else WScript.sleep(1) End If If Flug = False Then Set objIE = WScript.CreateObject("InternetExplorer.Application") objIE.Navigate strURL2 objIE.Visible = True Set objIE = Nothing End If ' 'いろいろな処理があるが省く ' If Flug = True Then msgbox "ヤフー存在" End If End If 絶対にフラグがTrueになることがありません。 Excelでデバッグしてみましたがなぜうまくいかないのかが理解できておりません。 自分としては開いているIEをぐるぐるとまず回ってヤフーが開いていればTrue時の処理を行い終了、 なければFalse時の処理を行うという風にしたいです(無限ループではありませんでした) For eachを使っているので途中でIf Flug以降の処理を行ってしまうのも無駄な繰り返しで困ってしまいます。 そこでフラグを立てることを考えたのですがどうも思うようにいきません。 ボキャブラリが足りませんが、いい知恵を貸していただけないでょうか?

  • エクセル VBA で IE操作 

    エクセルVBAにて IEを操作し リンクをクリックするには どのような記述になりますでしょうか? たとえば http://okwave.jp/mypage へアクセスし画面右上 カテゴリ をクリック 次に Excel(エクセル) をクリック という具合に 画面に表示されている文字を順番にクリックしたいです。 マクロを見つけてきましたが クリックというのはどう記述していいやらさっぱりです。 Sub testIE() Dim objIE As InternetExplorer 'IEオブジェクトを準備 Set objIE = CreateObject("Internetexplorer.Application") '新しいIEオブジェクトを作成してセット objIE.Visible = True 'IEを表示 objIE.navigate "http://okwave.jp/mypage" 'IEでURLを開く Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE '読み込み待ち DoEvents Loop

専門家に質問してみよう