為替の時系列データの取り込み

為替の時系列データの取り込みを
Webクエリを使って行います。

データの取得先は
YAHOO!ファイナンスです。

このサイトの「株式」のページで
以下の通貨の時系列データが見れます。

USDJPY
EURJPY
AUDJPY

上記3つの通貨ペアの時系列データを取り込んでいきます。
Webクエリの基本的な使い方は次の記事を参照ください。
記事「Webクエリまとめ」

まずは，USDJPYのみのデータを取り込む方法を見ていきます。
USDJPYのデータのURLは
"https://stocks.finance.yahoo.co.jp/stocks/history/?code=USDJPY=X"です。

次のコードは
上記URLのデータを取り込むWebクエリを作成します。

Sub macro20200506a()
'為替時系列データ用Webクエリ作成
    Dim cur_url As String

    cur_url = "https://stocks.finance.yahoo.co.jp/stocks/history/?code=USDJPY=X"
   
    Sheets.Add.Name = "為替クエリ"
    With ActiveSheet.QueryTables.Add( _
        Connection:="URL;" & cur_url, _
        Destination:=Range("A1"))
       
        .Name = "為替"
        .WebFormatting = xlWebFormattingNone '書式なし
        .Refresh
    End With

End Sub

実行結果：

「為替クエリ」シートが挿入されて
Webクエリが作成されました。

次は
過去にさかのぼってデータを取得していきます。

先ほどのサイトの少し下にスクロールすると
過去データの日付の範囲を指定できます。

とりあえず一番古い日付と最新の日付を指定して
表示をクリックします。

表示されたページのURLを見てください。
1ページ目のURLは，
https://info.finance.yahoo.co.jp/history/?code=USDJPY%3DX&sy=1983&sm=1&sd=1&ey=2020&em=5&ed=6&tm=d
2ページ目のURLは，
https://info.finance.yahoo.co.jp/history/?code=USDJPY%3DX&sy=1983&sm=1&sd=1&ey=2020&em=5&ed=6&tm=d&p=2
3ページ目のURLは，
https://info.finance.yahoo.co.jp/history/?code=USDJPY%3DX&sy=1983&sm=1&sd=1&ey=2020&em=5&ed=6&tm=d&p=3

ページごとにURLで異なる部分は
最後の&p=2,&p=3,...の部分です。

先ほど作成したWebクエリのURLを
1ページ目のURL，2ページ目のURL，3ページ目のURL，...と
順に変更して
Webクエリを更新していけば過去データも取得できます。

Webクエリを更新すると更新前のデータが消えるで
データを更新したら
その時点のWebクエリのデータを別のシートにコピペします。

ページ数がわからないので
とりあえず700ページまで取り込む設定にして
データがなくなったら終了するようにします。

Sub macro20200506b()
'為替時系列データ用Webクエリ作成

    Dim i As Integer, j As Integer
    Dim end_row As Integer
    Dim end_row_q As Integer
    Dim cur_str As String
    Dim cur_url1 As String, cur_url2 As String
    Dim sh1 As Object
    Dim rng_c As Range, rng_p As Range
    Dim de
   
    cur_str = "USDJPY"
    Sheets.Add.Name = cur_str
    Set sh1 = Sheets(cur_str)
   
    With sh1
        .Cells(1, 1) = cur_str
        .Cells(3, 1) = "日付"
        .Cells(3, 2) = "始値"
        .Cells(3, 3) = "高値"
        .Cells(3, 4) = "安値"
        .Cells(3, 5) = "終値"
    End With

    cur_url1 = "https://info.finance.yahoo.co.jp/history/?code="
    cur_url2 = "%3DX&sy=1983&sm=1&sd=1&ey=" & Year(Date) & _
        "&em=" & Month(Date) & _
        "&ed=" & Day(Date) & "&tm=d"
   
    For i = 1 To 700
        Debug.Print i & "ページ目取り込み中"
       
        'Webクエリを更新
        With Sheets("為替クエリ").QueryTables("為替")
            .Connection = "URL;" & cur_url1 & cur_str & cur_url2 & "&p=" & i
           
            .BackgroundQuery = False
            .Refresh
        End With
       
        'Webクエリ更新の終了判断
        If Sheets("為替クエリ").Cells(4, 1) = "" Then
            Exit For
        End If
       
        'データをコピー
        If sh1.Cells(4, 1) = "" Then
            end_row = 4
        Else
            end_row = sh1.Cells(3, 1).End(xlDown).Row + 1
        End If

        For j = 4 To 23
            If IsDate(Sheets("為替クエリ").Cells(j, 1)) Then
                end_row_q = j
            Else
                Exit For
            End If
        Next j
       
        Set rng_c = Sheets("為替クエリ").Range("A4:E" & end_row_q)
        Set rng_p = sh1.Range(sh1.Cells(end_row, 1), sh1.Cells(end_row + 19, 4))
       
        rng_c.Copy Destination:=rng_p
        sh1.Cells.EntireColumn.AutoFit
       
        'Escキーで中断できるようにDoEventsを挟む
        If i Mod 5 = 0 Then
            de = DoEvents
        End If

    Next i
   
End Sub

実行結果：

「USDJPY」シートが挿入されて
時系列データが取り込めました。

次はUSDJPY以外の通貨ペアのデータも取り込んでいきます。
マクロmacro20200506bで定義した変数cur_strを
別の通貨ペアに変更して
実行すればデータを取り込めます。

その際に，マクロmacro20200506bを改良してmacro20200506cにとし
変数cur_strを
他のマクロmacro20200506dから引数としてもらう形式にします。

準備として
取り込む通貨ペアのリストを入力するシートを作成します。
名前「通貨ペア」のシートを挿入してください。
内容を次の画像のように入力してください。

次のコードは
「通貨ペア」のシートに入力された通貨ペアの
時系列データを取得します。
マクロmacro20200506dの方を実行してください。

Sub macro20200506d()
'「通貨ペア」のシートに入力された通貨ペアの
'為替時系列データ取り込み

    Dim i As Integer
    Dim end_row As Integer
    Dim cur_str As String
    Dim sh As Object
   
    Set sh = Sheets("通貨ペア")
    end_row = sh.Cells(1, 1).End(xlDown).Row
   
    For i = 2 To end_row
        cur_str = sh.Cells(i, 1)
        Call macro20200506c(cur_str)
    Next i

End Sub
Sub macro20200506c(cur_str As String)
'為替時系列データ取り込み

    Dim i As Integer, j As Integer
    Dim end_row As Integer
    Dim end_row_q As Integer
    Dim cur_url1 As String, cur_url2 As String
    Dim sh1 As Object
    Dim rng_c As Range, rng_p As Range
    Dim de
   
    Sheets.Add.Name = cur_str
    Set sh1 = Sheets(cur_str)
   
    With sh1
        .Cells(1, 1) = cur_str
        .Cells(3, 1) = "日付"
        .Cells(3, 2) = "始値"
        .Cells(3, 3) = "高値"
        .Cells(3, 4) = "安値"
        .Cells(3, 5) = "終値"
    End With

    cur_url1 = "https://info.finance.yahoo.co.jp/history/?code="
    cur_url2 = "%3DX&sy=1983&sm=1&sd=1&ey=" & Year(Date) & _
        "&em=" & Month(Date) & _
        "&ed=" & Day(Date) & "&tm=d"
   
    For i = 1 To 700
        Debug.Print i & "ページ目取り込み中"
       
        'Webクエリを更新
        With Sheets("為替クエリ").QueryTables("為替")
            .Connection = "URL;" & cur_url1 & cur_str & cur_url2 & "&p=" & i
           
            .BackgroundQuery = False
            .Refresh
        End With
       
        'Webクエリ更新の終了判断
        If Sheets("為替クエリ").Cells(4, 1) = "" Then
            Exit For
        End If
       
        'データをコピー
        If sh1.Cells(4, 1) = "" Then
            end_row = 4
        Else
            end_row = sh1.Cells(3, 1).End(xlDown).Row + 1
        End If

        For j = 4 To 23
            If IsDate(Sheets("為替クエリ").Cells(j, 1)) Then
                end_row_q = j
            Else
                Exit For
            End If
        Next j
       
        Set rng_c = Sheets("為替クエリ").Range("A4:E" & end_row_q)
        Set rng_p = sh1.Range(sh1.Cells(end_row, 1), sh1.Cells(end_row + 19, 4))
       
        rng_c.Copy Destination:=rng_p
        sh1.Cells.EntireColumn.AutoFit
       
        'Escキーで中断できるようにDoEventsを挟む
        If i Mod 5 = 0 Then
            de = DoEvents
        End If

    Next i
   
End Sub

データの取得には時間がかかりますので
出かける前や就寝前に実行するのを勧めます。

使用Ver：Win10, Excel For Office365