「Webから株価データ取得(Yahoo)」とほぼ同じツールは、 （←←クリックでアマゾンのページを表示）この本に ツール名「tp01-ダウンロード(Yahoo)」で、マクロの説明付きでソースを公開しています。 マクロを改善して、自分専用の更に儲かるツール作成を考えている方はこの本を参考にして下さい。

自分に合った解析ツールを自作したいが、株価データのダウンロード方法が 判らないのでデータロード方法を教えて欲しいとのメールが数回あった。

Yahooファイナンスから株価データをダウンロードするマクロの最低限必要な基本的マクロ の説明をします。これは株データ以外のWebに表示されているデータ取り込みにも応用できます。 ただしサイトによってはダウンロード禁止の場合もあり、マクロ作成に当っては各サイトの注意書き にしたがいインターネット使用のマナーを守って下さい。

---

ダウンロード
これは説明用に作成したマクロでプロテクトを掛けてないのでソースを見ることが出来ます。
KI(load_np)ダウンロ−ド
(ただし、本ページで紹介のWebクエリで取得はIE7およびExcel2000では使用できなくなり、マクロでエラー発生の質問がくるので下記の実用版はIE7、Excel2000に対応できる「正規表現方式」で取得しています)。

なお、・週データ・月データ・日経平均・TOPIXを追加した「正規表現方式」の実用版、、 「エクセルで時系列株価取得」はベクターからダウンロードできます。
この実用版とほぼ同じツールは、「 新・Excel VBAで極めるシステムトレード　〜最強パワーアップ編 」のCD-ROMにもソースを公開で収録されています。

---

1.概略
株価のダウンロ−ドは特に難しいことは何もなく、Excelの通常操作でマクロも自動記録できます。
(1)メニューから「新しいWebクエリ」実行（下図参照）


(2)新しいWebクエリダイアロク(下図)へ必要事項入力（Excel2000のケース)


[1]WebのURL入力
　・これはYahooファイナンスの時系列を開き、銘柄コードと表示期間を
　　指定しWebページを開きそのURLを事前にコピーしておいた方がよい
　・ここへの貼り付けは、[Ctrl]+[V]キーで出来ます(右クリックは効かない）
表示期間を指定できる画面は2009/11月から変わり、時系列表の
右下にある「株価時系列データをもっと見る」クリックで入力
出来ます（その画面はWebクエリでの取り込みも可）

[2]Webページの1部取り込みであり「選択した表」にチェック

[3]そのWebページ内の表の位置指定（本例は"10"ですが時々変わります）
　　(このマクロ作成時は10だったが、2004/10/5より19に変わりました）

[4]保存するWebページの形式選択は、「なし」をチェック

[5]　「OK」クリック

※　このURL例は、時系列のデーリーデータですが、「本日の値動き」「財務指標」
　　「詳細情報」も同じようにダウンロード出来ます。また他のサイトの
　　　株価情報も大体同じ方法でダウンロード出来ます。（取得テーブル位置
　　　の数字は変更のこと）

'==================================================================================
Sub Macro1()
' マクロ記録日 : 2004/7/18  ユーザー名 : iryo
'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://table.yahoo.co.jp/t?c=2004&a=6&b=1&f=2004&d=7&e=18&g=d&s=1301.t&y=0&z=1301.t" _
        , Destination:=Range("A1"))
        .Name = "t?c=2004&a=6&b=1&f=2004&d=7&e=18&g=d&s=1301.t&y=0&z=1301.t"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "10"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .Refresh BackgroundQuery:=False
    End With
End Sub
'==================================================================================

'==================================================================================
Sub Macro1()
With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;http://table.yahoo.co.jp/t?c=2004&a=6&b=1&f=2004&d=7&e=18&g=d&s=1301.t&y=0&z=1301.t" _
    , Destination:=Range("A1"))

    .RefreshStyle = xlOverwriteCells
    .AdjustColumnWidth = False
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "10"                     '時々変更あり、最近は19
    .Refresh BackgroundQuery:=False
End With
End Sub
'==================================================================================

'==================================================================================
Const URLYAHOO As String = "URL;http://table.yahoo.co.jp/"
Const BASHO As String = ".t"     '東証

Dim urlweb As String             'Web接続先
Dim meino As String   '銘柄コード
Dim ymden As Date     '取得end日
Dim ymdst As Date     '取得スタート日
Dim endr As Integer   'データ貼り付け最終行
Dim d10y As String, d10m As String, d10d As String
Dim d11y As String, d11m As String, d11d As String
Sub load_np()

'過去データ削除-------------------------------------------------------------
    ActiveSheet.Unprotect
    For Each zu In ActiveSheet.Shapes
        zu.Delete
    Next

 Cells.Select
    Selection.ClearContents
    Range("A1").Select

'銘柄コード指定------------------------------------------------------------
    msg = "Yahooファイナンスからデータ取得する銘柄コード入力"
    meino = InputBox(msg, "銘柄コード入力", "")
    If meino = "" Then
        MsgBox "取得する銘柄コードを入力して下さい"
        Exit Sub
    End If
    If Len(meino) <> 4 Then
        MsgBox "取得する銘柄コードを数字4桁で入力して下さい"
        Exit Sub
    End If
'==================================================================================

'==================================================================================
'取得日の指定
    yyy = Date
   msg = "データ取得する日付を指定して下さい"
    ymd = InputBox(msg, "銘柄コード入力", yyy)
    If ymd = "" Then
        MsgBox "取得する日付を入力して下さい"
        Exit Sub
    End If
    If IsDate(ymd) = False Then
        MsgBox "日付(yy/mm/dd)を入力して下さい"
        Exit Sub
    End If

'取得1
    ymden = ymd
    ymdst = ymden - 70
    endr = 1
    Call 取得準備
    
'取得2
    ymden = ymdst - 1
    ymdst = ymden - 70
    
    Cells(10000, 1).End(xlUp).Select
    endr = ActiveCell.Row + 1
    Call 取得準備

'==================================================================================

'==================================================================================
Sub 取得準備()
'スタート日
    d10y = Year(ymdst)
    d10m = Month(ymdst)
    d10d = Day(ymdst)
'収得日
    d11y = Year(ymden)
    d11m = Month(ymden)
    d11d = Day(ymden)

'URLと日付指定
urlweb = URLYAHOO & "t?c=" & d10y & "&a=" & d10m & "&b=" & d10d & "&f=" & d11y & "&d=" _
        & d11m & "&e=" & d11d & "&g=d&s=" & meino & BASHO & "&y=0&z=" & meino & BASHO
Call 取得

End Sub
'==================================================================================

'==================================================================================
'データ整理
    Columns("G").Delete Shift:=xlToLeft    '調整後終値*カット
    Columns("B").Insert Shift:=xlToRight   'B列を空ける
    Columns("G").Cut                      'G列切り取り
    Range("B1").Select
    ActiveSheet.Paste                        'B列へ貼り付け
    Range("A1").Select

    Cells(10000, 1).End(xlUp).Select
    cend2 = ActiveCell.Row
  
'株データ以外の行削除
For i = cend2 To 4 Step -1
  If IsNumeric(Cells(i, 2)) = False Or Cells(i, 2) = "" Then
       Rows(i).Select
       Selection.Delete Shift:=xlUp
  End If
Next
  Range("A1").Select
End Sub
'==================================================================================

'==================================================================================
Sub 取得()
With ActiveSheet.QueryTables.Add(Connection:=urlweb _
        , Destination:=Cells(endr, 1))
    .RefreshStyle = xlOverwriteCells
    .AdjustColumnWidth = False
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "19"
    .Refresh BackgroundQuery:=False
End With
End Sub
'==================================================================================