前回までは、価格情報のJSON形式データを取得し、Excelシート上にデータを表示するプログラムについてお伝えしました。
前回までの記事はこちら↓
第1回 仮想通貨取引所BitmexからOHLCVデータを取得するVBAプログラム －Excel VBA
第2回 仮想通貨取引所BitmexからOHLCVデータを取得するVBAプログラム －Excel VBA
第3回 仮想通貨取引所BitmexからOHLCVデータを取得するVBAプログラム －Excel VBA
Bitmexへの登録はこちらからどうぞ！1分で登録できます！
https://www.bitmex.com/register/oDtFNI
今回は前回までのプログラムをつなげたものとなります。
・環境構築
環境設定については以前の記事でまとめています。こちらをご覧ください。webサイトからExcelにJSON形式データを読み込むための下準備
・VBAコード
公式APIから公開されているベース時間足(1分足、5分足、1時間足、日足)だけでなく、それを利用して集計時間足（3分足、15分足、30分足、2時間足、週足など）のデータを集計しています。流れとしては、ベース時間足の時は取得したJSONデータをセルに出力します。
集計時間足の時は、取得したJSONデータをセルに出力し、そのセルから配列変数に格納し集計してまたセルに出力します。どうしてこうするかというと、同一シート上の同じ場所しか使用したくないからです。また、なぜ一度セルに出力するのかというと、試した結果一度セルに出力しないよりも処理速度が速くなったからです。他にもっと簡潔で処理が速くなる記述の仕方があるかもしれないので、参考程度に見て下さい。
このプログラムは約70万行の1分足のOHLCVデータを、計測したところ約2分程度で取得して表示しました。努力次第でまだ速くなるかもしれません。
Option Explicit
Sub Bitmex_JSON()
'20180528
'Developed by: https://yare-excel-google-spreadsheet.blogspot.jp/
'twitter: https://twitter.com/VBAExcel
Dim CryptoJSON As Object, CryptoNode
Dim HttpReq As Object, CandleJSON As String
Dim bmsheet As Worksheet
Dim js As Object
Dim objJSON As Object
Dim TradeJSON As String
Dim url As String
Dim MaxRow As Long
Dim binsize As String
Dim utm_arr() As Long
Dim opn_arr() As Double
Dim cls_arr() As Double
Dim max_arr() As Double
Dim min_arr() As Double
Dim vol_arr() As Double
Dim tmpT() As Long
Dim tmpO() As Double
Dim tmpH() As Double
Dim tmpL() As Double
Dim tmpC() As Double
Dim tmpV() As Double
Dim Region()
Dim tmp1
Dim tmp2
Dim tmp3
Dim tmp4
Dim tmp5
Dim tmp6
Dim stick As Long
Dim resolution As Long
Dim startnum As Long
Dim from As Long
Dim toend As Long
Dim endnum As Long
Dim num As Long
Dim a As Long
Dim i As Long
Dim j As Long
Dim c As Long
Dim Varr As Long
Application.StatusBar = "loading・・・"
Application.ScreenUpdating = False
Application.EnableCancelKey = xlErrorHandler
Set bmsheet = ThisWorkbook.Worksheets("bitmex")
bmsheet.Range("F:K").Clear
binsize = bmsheet.Cells(6, 2).Value
If binsize = "1m" Or binsize = "5m" Or binsize = "1h" Or binsize = "1d" Then
stick = 1
ElseIf binsize = "3m" Or binsize = "15m" Then
stick = 3
ElseIf binsize = "30m" Or binsize = "6h" Then
stick = 6
ElseIf binsize = "2h" Then
stick = 2
ElseIf binsize = "4h" Then
stick = 4
ElseIf binsize = "12h" Then
stick = 12
ElseIf binsize = "1w" Then
stick = 7
Else: End If
If binsize = "1m" Or binsize = "3m" Then
resolution = 1
ElseIf binsize = "5m" Or binsize = "15m" Or binsize = "30m" Then
resolution = 5
ElseIf binsize = "1h" Or binsize = "2h" Or binsize = "4h" Or binsize = "6h" Or binsize = "12h" Then
resolution = 60
ElseIf binsize = "1d" Or binsize = "1w" Then
resolution = 1440
Else: End If
a = 0
i = 0
startnum = bmsheet.Cells(13, 2).Value + (resolution * 60)
endnum = bmsheet.Cells(13, 3).Value + (resolution * stick * 60)
num = (endnum - startnum) / (resolution * 60) + 1
c = CLng(10000) * (resolution * 60)
If binsize <> "1m" And binsize <> "5m" And binsize <> "1h" And binsize <> "1d" Then
Varr = num / stick + 1
ReDim utm_arr(Varr) As Long
ReDim opn_arr(Varr) As Double
ReDim cls_arr(Varr) As Double
ReDim max_arr(Varr) As Double
ReDim min_arr(Varr) As Double
ReDim vol_arr(Varr) As Double
ReDim Region(1 To Varr, 1 To 6)
Else: End If
Do While toend < endnum
If num > 10000 Then
from = (startnum + c * i)
toend = startnum + c * (i + 1)
num = num - 10000
ElseIf num <= 10000 Then
from = startnum + c * i
toend = endnum
End If
url = "https://www.bitmex.com/api/udf/history?symbol=XBTUSD&resolution=" & resolution & "&from=" & from & "&to=" & toend
Debug.Print url
'Query Api
Set HttpReq = CreateObject("MSXML2.XMLHTTP")
HttpReq.Open "GET", url, False
HttpReq.send
TradeJSON = HttpReq.responseText
Set HttpReq = Nothing
Set js = CreateObject("ScriptControl")
js.Language = "JScript"
js.AddCode "function jsonParse(s) { return eval('(' + s + ')'); }"
'追加した関数を実行して、結果を変数に格納する
Set CryptoJSON = js.CodeObject.jsonParse(TradeJSON)
tmp1 = Split(CryptoJSON.t, ",")
tmp2 = Split(CryptoJSON.o, ",")
tmp3 = Split(CryptoJSON.h, ",")
tmp4 = Split(CryptoJSON.l, ",")
tmp5 = Split(CryptoJSON.c, ",")
tmp6 = Split(CryptoJSON.v, ",")
'ベース時間足
With bmsheet
.Range(.Cells(1 + i * 10000, 11), .Cells(i * 10000 + UBound(tmp1), 11)) = WorksheetFunction.Transpose(tmp1)
.Range(.Cells(1 + i * 10000, 6), .Cells(i * 10000 + UBound(tmp2), 6)) = WorksheetFunction.Transpose(tmp2)
.Range(.Cells(1 + i * 10000, 7), .Cells(i * 10000 + UBound(tmp3), 7)) = WorksheetFunction.Transpose(tmp3)
.Range(.Cells(1 + i * 10000, 8), .Cells(i * 10000 + UBound(tmp4), 8)) = WorksheetFunction.Transpose(tmp4)
.Range(.Cells(1 + i * 10000, 9), .Cells(i * 10000 + UBound(tmp5), 9)) = WorksheetFunction.Transpose(tmp5)
.Range(.Cells(1 + i * 10000, 10), .Cells(i * 10000 + UBound(tmp6), 10)) = WorksheetFunction.Transpose(tmp6)
End With
i = i + 1
a = 0
Loop
'ここからベース時間足以外の時間足を集計
With bmsheet
MaxRow = .Cells(Rows.Count, 6).End(xlUp).Row
If binsize <> "1m" And binsize <> "5m" And binsize <> "1h" And binsize <> "1d" Then
For j = 0 To MaxRow - stick Step stick
utm_arr(a) = .Cells(1 + j, 11).Value
opn_arr(a) = .Cells(1 + j, 6).Value
cls_arr(a) = .Cells(j + stick, 9).Value
max_arr(a) = WorksheetFunction.max(.Range(.Cells(1 + j, 7), .Cells(stick + j, 7)))
min_arr(a) = WorksheetFunction.min(.Range(.Cells(1 + j, 8), .Cells(stick + j, 8)))
vol_arr(a) = WorksheetFunction.Sum(.Range(.Cells(1 + j, 10), .Cells(stick + j, 10)))
a = a + 1
Next
For j = 0 To a - 1
Region(j + 1, 6) = utm_arr(j)
Region(j + 1, 1) = opn_arr(j)
Region(j + 1, 2) = max_arr(j)
Region(j + 1, 3) = min_arr(j)
Region(j + 1, 4) = cls_arr(j)
Region(j + 1, 5) = vol_arr(j)
Next
.Range("F:K").Clear
Dim RowMax As Long
'１次元目の要素数を取得
RowMax = UBound(Region, 1) - LBound(Region, 1) + 1
.Range("F1").Resize(RowMax, 6).Value = Region
Else: End If
If .Cells(7, 2).Value = "true" Then
.Range(.Cells(1, 6), .Cells(MaxRow, 11)).Sort Key1:=.Cells(1, 11), order1:=xlDescending
Else: End If
If .Cells(8, 2).Value = "date" Then
MaxRow = .Cells(Rows.Count, 7).End(xlUp).Row
For i = 1 To MaxRow
.Cells(i, 11).Value = (.Cells(i, 11).Value + 32400) / 86400 + 25569
Next
.Range("K:K").NumberFormatLocal = "yyyy/mm/dd hh:mm"
Else: End If
End With
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
全部で約190行です。
これで第4回まで投稿してきた「仮想通貨取引所BitmexからOHLCVデータを取得するVBAプログラムシリーズ」は終わりとなります。ここまで読んでいただきありがとうございます。
また何かプログラムを作成したら公開しようと思っていますので当ブログを時々チェックしていただければ幸いです。
・終わりに
これで第4回まで投稿してきた「仮想通貨取引所BitmexからOHLCVデータを取得するVBAプログラムシリーズ」は終わりとなります。ここまで読んでいただきありがとうございます。
また何かプログラムを作成したら公開しようと思っていますので当ブログを時々チェックしていただければ幸いです。
このVBAプログラムを使用したExcelアプリケーションの作り方をnoteにまとめました。こちらもご覧ください。
[メクセル君] BitmexからOHLCVデータを取得するExcelアプリケーションの作り方
第1回 仮想通貨取引所BitmexからOHLCVデータを取得するVBAプログラム －Excel VBA
第2回 仮想通貨取引所BitmexからOHLCVデータを取得するVBAプログラム －Excel VBA
第3回 仮想通貨取引所BitmexからOHLCVデータを取得するVBAプログラム －Excel VBA
他にもエクセルツールを作成しています！
どんなに小さな額でもチップをいただけると嬉しいです！
Donate BTC: 1LcULwCQPjxLGXdpEJkhNkPpqCwG5csasU
Donate LTC: LSXEG7tjeCCGWuzvf5eFvJUZM6Xpvsdc4f
当エクセルツールから表示される情報は、
内容の正確性、信頼性等を保証するものではありません。
これらの情報に基づいて被ったいかなる損害についても、当サイトは一切の責任を負いません。
投資・投機に関するすべての決定は、利用者ご自身の判断でなさるようお願いいたします。
