| |
こんにちは。かみちゃん です。
>>Internet Explorer（IE）を直接制御するという方法もありますが、こちらの方は、
>>HTMLの解析が必要ですので、HTMLの知識が必要になります。
>>
>>以下のＵＲＬでIEの制御方法については、参考になるかもしれません。
>>http://www.ken3.org/cgi-bin/group/vba_ie.asp
>
>最後の最後まで、本当にありがとうございます。
>是非、参考にさせてもらいます。
すでに解決済みかもしれませんが、一応、IEを直接制御する方法で書き直してみました。
回線が混んでいるせいか、さきほど、取得完了まで20分かかりましたが、問題なく取得することができました。
Sub Macro2()
'参考ＵＲＬ
'http://www.ken3.org/vba/backno/vba097.html
Dim objIE As Object 'ＩＥオブジェクト参照用
Dim objITEM As Object
Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
Dim ii As Long
Dim market As String, strCode As String
'Dt010 取引値 9/15 226
'Dt030 前日比 -8 (-3.42%)
'Dt031 前日比 -8 (-3.42%)
'Dt040 前日終値 234
'Dt050 出来高 26,927,000
'Dt060 時価総額 25,543百万円
Dim Dt010 As Currency, Dt030 As Currency, Dt031 As Double, Dt040 As Currency, Dt050 As Currency, Dt060 As Currency
'Dt110 始値 224
'Dt120 高値 231
'Dt130 安値 214
'Dt140 売気配 ---
'Dt150 買気配 ---
'Dt160 発行済株式数 113,023,000株
Dim Dt110 As Currency, Dt120 As Currency, Dt130 As Currency, Dt140 As Currency, Dt150 As Currency, Dt160 As Currency
'Dt210 配当利回り 0.0044
'Dt220 1株配当 1.00円
'Dt230 株価収益率 (連) 11.44倍
'Dt240 1株利益 (連) 19.76円
'Dt250 純資産倍率 (連) 1.26倍
'Dt260 1株株主資本 (連) 179.51円
Dim Dt210 As Double, Dt220 As Currency, Dt230 As Double, Dt240 As Currency, Dt250 As Double, Dt260 As Currency
'Dt310 株主資本比率 (連) 3.0%
'Dt320 株主資本利益率 (連) 11.86%
'Dt330 総資産利益率 (連) 0.33%
'Dt340 調整1株益 (連) 19.75円
'Dt350 決算年月 2005年3月
'Dt360 単元株数 1,000株
'Dt350 決算年月が"---"表示の場合があるため、Date型ではなくString型で宣言する
Dim Dt310 As Double, Dt320 As Double, Dt330 As Double, Dt340 As Currency, Dt350 As String, Dt360 As Currency
Dim St As String, MyURL As String
Dim StartRow As Long, InputRow As Long
Dim TgN As String, CpN As String
Const URL As String = "http://quote.yahoo.co.jp/q?s="
Dim strSplit As String
'処理時間を計測する。
Dim StartTime As Date
'処理時間を計測する。
StartTime = Now()
Set Sh1 = Worksheets("Sheet1") '取得結果出力シート
Set Sh2 = Worksheets("Sheet2") 'Webクエリ作業シート
Set Sh3 = Worksheets("Sheet3") '抽出銘柄コード一覧設定シート
If IsEmpty(Sh3.Range("A2").Value) Then GoTo ELine
Application.StatusBar = False
ii = 2
StartRow = ii
If Sh1.Range("S65536").End(xlUp).Row = StartRow Then
With Sh1.Range("A2", Sh1.Range("S65536").End(xlUp))
.ClearContents
.NumberFormatLocal = "G/標準"
End With
End If
Sh1.Range("A1").Resize(, 19) = Array("銘柄コード", "銘柄名", "市場", "始値", "高値", "安値", "終値", "出来高", "発行済株式数", "1株利益", "1株配当", "株価収益率", "純資産倍率", "1株株主資本", "株主資本比率", "株主資本利益率", "総資産利益率", "決算年月", "単元株数")
'インターネットエクスプローラーのオブジェクトを作る
Set objIE = CreateObject("InternetExplorer.application")
Do Until Sh3.Cells(StartRow, "A").Value = ""
InputRow = 1
St = ""
'50銘柄単位ずつ処理する
Do Until InputRow > 50 Or Sh3.Cells(StartRow - 1 + InputRow, "A").Value = ""
If IsNumeric(Sh3.Cells(StartRow - 1 + InputRow, "A").Value) And Len(Sh3.Cells(StartRow - 1 + InputRow, "A").Value) = 4 Then
St = St & Sh3.Cells(StartRow - 1 + InputRow, "A").Value & "+"
InputRow = InputRow + 1
End If
Loop
StartRow = StartRow + InputRow - 1
If St = "" Then GoTo ELine
St = Left$(St, Len(St) - 1)
MyURL = URL & St & "&d=t"
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
With objIE
.Visible = True
'文字列で指定したＵＲＬに飛ぶ
.Navigate MyURL
'表示終了まで待つ
Do While .Busy Or .ReadyState <> 4
DoEvents
Loop
For Each objITEM In .document.getElementsByTagName("TABLE")
If InStr(objITEM.Rows(0).Cells(0).InnerText, "関連情報") <> 0 Then
TgN = Trim(objITEM.Rows(0).Cells(0).InnerText)
'銘柄名に「(株)」という文字があった場合の対応
If InStr(TgN, "(株)") <> 0 Then
If InStr(TgN, "(株)") = 1 Then
CpN = Left$(TgN, InStr(4, TgN, "(") - 1)
Else
CpN = Left$(TgN, InStr(1, TgN, ")"))
End If
Else
CpN = Left$(TgN, InStr(1, TgN, "(") - 1)
End If
'市場名を取得
market = Mid(objITEM.Rows(0).Cells(0).InnerText, 1, InStr(objITEM.Rows(0).Cells(0).InnerText, ":") - 1)
If InStrRev(market, "(") <> 0 Then
market = Mid(market, InStrRev(market, "(") + 1)
End If
strCode = Mid(objITEM.Rows(0).Cells(0).InnerText, InStr(objITEM.Rows(0).Cells(0).InnerText, ":") + 1)
If InStrRev(strCode, ")") <> 0 Then
strCode = Mid(strCode, 1, InStrRev(strCode, ")") - 1)
End If
'取引値（終値）
Dt010 = Val(Replace(Split(objITEM.Rows(1).Cells(0).InnerText, " ")(1), ",", ""))
'前日比
strSplit = Split(objITEM.Rows(1).Cells(1).InnerText, vbLf)(1)
Dt030 = Val(Replace(Split(strSplit, " ")(0), ",", ""))
Dt031 = Val(Replace(Replace(Replace(Split(strSplit, " ")(1), "(", ""), "%)", ""), ",", "")) / 100
'前日終値
Dt040 = Val(Replace(Split(objITEM.Rows(1).Cells(2).InnerText, vbLf)(1), ",", ""))
'出来高
Dt050 = Val(Replace(Split(objITEM.Rows(1).Cells(3).InnerText, vbLf)(1), ",", ""))
'時価総額
Dt060 = Val(Replace(Split(objITEM.Rows(1).Cells(4).InnerText, vbLf)(1), ",", ""))
'始値
Dt110 = Val(Replace(Split(objITEM.Rows(2).Cells(0).InnerText, vbLf)(1), ",", ""))
'高値
Dt120 = Val(Replace(Split(objITEM.Rows(2).Cells(1).InnerText, vbLf)(1), ",", ""))
'安値
Dt130 = Val(Replace(Split(objITEM.Rows(2).Cells(2).InnerText, vbLf)(1), ",", ""))
'売気配
Dt140 = Val(Replace(Split(objITEM.Rows(2).Cells(3).InnerText, vbLf)(1), ",", ""))
'買気配
Dt150 = Val(Replace(Split(objITEM.Rows(2).Cells(4).InnerText, vbLf)(1), ",", ""))
'発行済株式数
Dt160 = Val(Replace(Split(objITEM.Rows(2).Cells(5).InnerText, vbLf)(1), ",", ""))
'配当利回り
Dt210 = Val(Replace(Replace(Split(objITEM.Rows(3).Cells(0).InnerText, vbLf)(1), ",", ""), "%", "")) / 100
'1株配当
Dt220 = Val(Replace(Split(objITEM.Rows(3).Cells(1).InnerText, vbLf)(1), ",", ""))
'株価収益率
strSplit = Split(objITEM.Rows(3).Cells(2).InnerText, vbLf)(1)
Dt230 = Val(Replace(Split(strSplit, " ")(UBound(Split(strSplit, " "))), ",", ""))
'1株利益
strSplit = Split(objITEM.Rows(3).Cells(3).InnerText, vbLf)(1)
Dt240 = Val(Replace(Split(strSplit, " ")(UBound(Split(strSplit, " "))), ",", ""))
'純資産倍率
strSplit = Split(objITEM.Rows(3).Cells(4).InnerText, vbLf)(1)
Dt250 = Val(Replace(Split(strSplit, " ")(UBound(Split(strSplit, " "))), ",", ""))
'1株株主資本
strSplit = Split(objITEM.Rows(3).Cells(5).InnerText, vbLf)(1)
Dt260 = Val(Replace(Split(strSplit, " ")(UBound(Split(strSplit, " "))), ",", ""))
'株主資本比率
strSplit = Split(objITEM.Rows(4).Cells(0).InnerText, vbLf)(1)
Dt310 = Val(Replace(Replace(Split(strSplit, " ")(UBound(Split(strSplit, " "))), ",", ""), "%", "")) / 100
'株主資本利益率
strSplit = Split(objITEM.Rows(4).Cells(1).InnerText, vbLf)(1)
Dt320 = Val(Replace(Replace(Split(strSplit, " ")(UBound(Split(strSplit, " "))), ",", ""), "%", "")) / 100
'総資産利益率
strSplit = Split(objITEM.Rows(4).Cells(2).InnerText, vbLf)(1)
Dt330 = Val(Replace(Replace(Split(strSplit, " ")(UBound(Split(strSplit, " "))), ",", ""), "%", "")) / 100
'調整1株益
strSplit = Split(objITEM.Rows(4).Cells(3).InnerText, vbLf)(1)
Dt340 = Val(Replace(Replace(Split(strSplit, " ")(UBound(Split(strSplit, " "))), ",", ""), "%", ""))
'決算年月
strSplit = Split(objITEM.Rows(4).Cells(4).InnerText, vbLf)(1)
If IsDate(strSplit) Then
Dt350 = Format(strSplit, "yyyy年mm月")
Else
Dt350 = ""
End If
'単元株数
Dt360 = Val(Replace(Split(objITEM.Rows(4).Cells(5).InnerText, vbLf)(1), ",", ""))
' 'セルに出力する。
' '始値 高値 安値 終値 出来高 発行済株式数 1株利益 1株配当 株価収益率 純資産倍率 1株株主資本 株主資本比率 株主資本利益率 総資産利益率 決算年月 単元株数
' 'Dt110 Dt120 Dt130 Dt010 Dt050 Dt160 Dt240 Dt220 Dt230 Dt250 Dt260 Dt310 Dt320 Dt330 Dt350 Dt360
Sh1.Cells(ii, 1).Resize(, 19).Value = _
Array(strCode, CpN, market, Dt110, Dt120, Dt130, Dt010, Dt050, Dt160, Dt240, Dt220, Dt230, Dt250, Dt260, Dt310, Dt320, Dt330, Dt350, Dt360)
ii = ii + 1
End If
Next
End With
Loop
'インターネットエクスプローラを閉じる
objIE.Quit
Set objIE = Nothing
'抽出したデータのセルの書式設定
Range("A2", Range("S65536").End(xlUp)).NumberFormatLocal = "G/標準"
Range("R2", Range("R65536").End(xlUp)).NumberFormatLocal = "yyyy""年""m""月"";@"
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
'処理時間を表示する。 2005.10.02 UpDate by kamicha1
MsgBox "株価情報取得処理を終了しました" & vbCrLf & _
" 処理時間：" & Format(Now() - StartTime, "hh:mm:ss")
ELine:
Set Sh1 = Nothing: Set Sh2 = Nothing: Set Sh3 = Nothing
End Sub
|
|
かみちゃん
- 05/12/28(水) 23:45 -
