ブラッシュアップ 削除
Message#3 2016年3月3日(木)11時20分 From: VBA悩み |
ありがとうございます。 他にもありましたらどんどんお願い致します。 ジャッカルのメッセージ(#2)への返事 > 型宣言でLongを使っているけどそんなにでかい数字ある? > 金額とかIntegerで十分だと思うが。 > > > 下記について直した方が早くなるなどありましたらお知恵をお貸しいただけると助かります。 > > > > 宜しくお願い致します。 > > > > 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 |
上のメッセージを削除します。
よければパスワードを入力し、削除ボタンをクリックしてください。