| |
こんにちは。かみちゃん です。
>>私も
>>Yahoo!ファイナンス
>>http://quote.yahoo.co.jp/
>>から株価情報を600銘柄取得していますが、特に問題はおきていません。
>>今使っているコードは、かなり作りこんでしまっているので、のちほど、株価取得
>>の部分のコードだけ切り出して提示してみましょうか？
>
>是非、お願い致しますm(_ _)m
すでにKeinさんからコメントがついていて、解決の方向に向かわれているかもしれ
ませんが、私が使っているコードでサンプルを作ってみました。
Sheet3のA列に取得したい銘柄コードを記述します。
Sheet2にWebクエリの結果を取得して、Sheet1にその情報に基づきデータベースを
出力します。
実は、このコードは、とある掲示板で元々Keinさんから教えていただいたものに、
私なりに必要なコードを追加しています。
Sheet3の取得対象銘柄コードには、1001〜9999と連番で9000個のコードを設定して
Sheet1には、取得できた銘柄コード3888個のデータを取得するのに、約4分かかり
ましたが、特段のトラブルなく問題なく完了しました。
Sub Macro1()
Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
Dim C As Range, FR2 As Range
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, Ad As String
Dim TgS As String, CpN As String
Dim StartRow As Long, InputRow As Long
Dim TgN As String
Dim Dt6 As String
Const URL As String = "http://quote.yahoo.co.jp/q?s="
'処理時間を計測する。
Dim StartTime As Date
'処理時間を計測する。
StartTime = Now()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
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株株主資本", "株主資本比率", "株主資本利益率", "総資産利益率", "決算年月", "単元株数")
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;" & URL & St & "&d=t"
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Sh2.Cells.Clear
With Sh2.QueryTables.Add(MyURL, Sh2.Range("A1"))
.Name = St
.PreserveFormatting = True
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SaveData = True
'--- Keinさんより ここから
'.RefreshPeriod = 0
'--- Keinさんより ここまで
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
'--- Keinさんより ここから
.EnableRefresh = False
With .ResultRange
.Copy
.PasteSpecial xlPasteValues
End With
'--- Keinさんより ここまで
End With
Set FR2 = Sh2.Range("A:A").Find("取引値", , xlValues, , , xlPrevious)
If Not FR2 Is Nothing Then
Ad = FR2.Address
Do
Set FR2 = Sh2.Range("A:A").FindNext(FR2)
TgN = Trim(FR2.Offset(-1).Value)
'銘柄名に「(株)」という文字があった場合の対応
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(FR2.Offset(-1), 1, InStr(FR2.Offset(-1), ":") - 1)
If InStrRev(market, "(") <> 0 Then
market = Mid(market, InStrRev(market, "(") + 1)
End If
strCode = Mid(FR2.Offset(-1), InStr(FR2.Offset(-1), ":") + 1)
If InStrRev(strCode, ")") <> 0 Then
strCode = Mid(strCode, 1, InStrRev(strCode, ")") - 1)
End If
'取引値（終値）
Dt010 = Val(Replace(Split(FR2.Offset(1).Value, " ")(1), ",", ""))
'前日比
Dt030 = Val(Replace(Split(FR2.Offset(1, 2).Value, " ")(0), ",", ""))
Dt031 = Val(Replace(Replace(Replace(Split(FR2.Offset(1).Value, " ")(1), "(", ""), "%)", ""), ",", "")) / 100
'前日終値
Dt040 = Val(Replace(FR2.Offset(1, 3).Value, ",", ""))
'出来高
Dt050 = Val(Replace(FR2.Offset(1, 4).Value, ",", ""))
'時価総額
Dt060 = Val(Replace(FR2.Offset(1, 5).Value, ",", ""))
'始値
Dt110 = Val(Replace(FR2.Offset(3).Value, ",", ""))
'高値
Dt120 = Val(Replace(FR2.Offset(3, 1).Value, ",", ""))
'安値
Dt130 = Val(Replace(FR2.Offset(3, 2).Value, ",", ""))
'売気配
Dt140 = Val(Replace(FR2.Offset(3, 3).Value, ",", ""))
'買気配
Dt150 = Val(Replace(FR2.Offset(3, 4).Value, ",", ""))
'発行済株式数
Dt160 = Val(Replace(FR2.Offset(3, 5).Value, ",", ""))
'配当利回り
Dt210 = Val(Replace(FR2.Offset(5).Value, ",", ""))
'1株配当
Dt220 = Val(Replace(FR2.Offset(5, 1).Value, ",", ""))
'株価収益率
Dt230 = Val(Replace(Split(FR2.Offset(5, 2).Value, " ")(UBound(Split(FR2.Offset(5, 2).Value, " "))), ",", ""))
'1株利益
Dt240 = Val(Replace(Split(FR2.Offset(5, 3).Value, " ")(UBound(Split(FR2.Offset(5, 3).Value, " "))), ",", ""))
'純資産倍率
Dt250 = Val(Replace(Split(FR2.Offset(5, 4).Value, " ")(UBound(Split(FR2.Offset(5, 4).Value, " "))), ",", ""))
'1株株主資本
Dt260 = Val(Replace(Split(FR2.Offset(5, 5).Value, " ")(UBound(Split(FR2.Offset(5, 5).Value, " "))), ",", ""))
'株主資本比率
Dt310 = Val(Replace(Replace(Split(FR2.Offset(7).Value, " ")(UBound(Split(FR2.Offset(7).Value, " "))), ",", ""), "%", "")) / 100
'株主資本利益率
Dt320 = Val(Replace(Replace(Split(FR2.Offset(7, 1).Value, " ")(UBound(Split(FR2.Offset(7, 1).Value, " "))), ",", ""), "%", "")) / 100
'総資産利益率
Dt330 = Val(Replace(Replace(Split(FR2.Offset(7, 2).Value, " ")(UBound(Split(FR2.Offset(7, 2).Value, " "))), ",", ""), "%", "")) / 100
'調整1株益
Dt340 = Val(Replace(Replace(Split(FR2.Offset(7, 3).Value, " ")(UBound(Split(FR2.Offset(7, 3).Value, " "))), ",", ""), "%", ""))
'決算年月
If IsDate(FR2.Offset(7, 4).Value) Then
Dt350 = Format(FR2.Offset(7, 4).Value, "yyyy年mm月")
Else
Dt350 = ""
End If
'単元株数
Dt360 = Val(Replace(FR2.Offset(7, 5).Value, ",", ""))
'セルに出力する。
'始値 高値 安値 終値 出来高 発行済株式数 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
Loop Until FR2.Address = Ad
'作業用シートの値をクリアする。
Sh2.Cells.Clear
Else
End If
Loop
Set FR2 = Nothing: Sh1.Activate
'抽出したデータのセルの書式設定
Range("A3", Range("S65536").End(xlUp)).NumberFormatLocal = "G/標準"
Range("R3", Range("R65536").End(xlUp)).NumberFormatLocal = "yyyy""年""m""月"";@"
'存在しない銘柄があった場合は、コピーするとずれるのでやめる
'Sh1.Range("H6", Sh1.Range("H65536").End(xlUp)).Copy Sh1.Range("M6")
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(水) 15:36 -
