ブラッシュアップ
昨日以降(0) ２日前以降(0) ３日前以降(0) ４日前以降(0) ５日前以降(0)
| Message#1 2016年3月2日(水)17時40分 From: vba初心者 | 返事 削除 変更 |
| 下記について直した方が早くなるなどありましたらお知恵をお貸しいただけると助かります。 宜しくお願い致します。 Sub sample() Dim rc As Integer rc = MsgBox("処理を行いますか？", vbYesNo + vbQuestion, "確認") If rc = vbYes Then Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim objIE As InternetExplorer Dim i As Integer Dim ii As Integer Dim objLink As Object Dim h As Long Dim hh As String Dim hhh As Long Dim atag As String Dim big As String Dim cate As String Set ws1 = Workbooks("kakakucom(ranking)").Worksheets("search") 'ストップウォッチ t = Timer cate = Cells(1, 6) For ii = 0 To 3 'データ抽出用ページをIE（InternetExplorer）で起動 Call ieView(objIE, "http://kakaku.com/ranking/kaden/") 'リンクをクリックして同じウィンドウで表示する Call linkClick(objIE, cate) '("rkgBoxName")(i)のaタグを取得し【atag】に収納 atag = objIE.Document.getElementsByClassName("rkgBoxName")(ii).innerHTML 'リンクをクリックして同じウィンドウで表示する Call linkClick(objIE, atag) '指定したclass属性の文書ドキュメント【型番】を抽出する hh = objIE.Document.getElementsByTagName("h2")(0).innerHTML ws1.Cells(ii + 1, 1) = hh '指定したclass属性の文書ドキュメント【金額】を抽出する h = classValue(objIE, "fontPrice wordwrapPrice", "p", "innerText") ws1.Cells(ii + 1, 2) = h 'HTMLタグがaタグ要素を全て抽出する For i = 0 To objIE.Document.getElementsByClassName("wordwrapShop").Length - 1 If objIE.Document.getElementsByClassName("wordwrapShop")(i).innertext = "onHOMEオンホーム" Then 'リンクをクリックして同じウィンドウで表示する Call linkClick(objIE, "onHOMEオンホーム") '指定したclass属性の文書ドキュメント【金額】を抽出する hhh = objIE.Document.getElementsByClassName("impact02")(0).innertext ws1.Cells(ii + 1, 3) = hhh '閉じてお掃除 Exit For Else End If Next i objIE.Quit Set objIE = Nothing Next ii 'Exit For MsgBox Timer - t Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Else MsgBox "処理を中断します" End If '確認の終わり End Sub |
昨日以降 ２日前以降 ３日前以降 ４日前以降 ５日前以降
