楽天証券のRSS作り直しのその後

楽天証券のRSSで4本値作成ですが、

市場が開いているときにテストをしたのですが・・・

いまいちな結果・・・

RSSのレート配信時間に同期しようとすると、

配信データが数分更新されないこともあり、

1分毎のデータを作成することができませんでした。

なので、時間はシステム時間に合わせて1分データを作成。

まだいまいちですが、次テストできる日まで保留にしたいと思います。

コードをブログで記録しておきます。


ランキングに参加しています。
よかったらポチお願いします。
にほんブログ村 IT技術ブログ VBAへ
にほんブログ村




クラス clsRSS を作成し次のコードを入力


Private WithEvents sh_RSS As Worksheet
Public WithEvents SysTimer As clsSysTimer

Private gVar As Variant
Private gNewRow As Long
Private gCode As String
Private gState As Boolean

Sub OpenRssSheet(sSheetName As String)

gCode = Right(sSheetName, 4)

Set sh_RSS = ThisWorkbook.Worksheets(sSheetName)

Clear
sh_RSS.Cells(2, 1).Value = "1分足"
sh_RSS.Cells(2, 2).Value = "始値"
sh_RSS.Cells(2, 3).Value = "安値"
sh_RSS.Cells(2, 4).Value = "高値"
sh_RSS.Cells(2, 5).Value = "終値"
sh_RSS.Cells(2, 6).Value = "配信時刻"
sh_RSS.Cells(1, 5).Value = "=RSS|'" & gCode & ".T.'!現在値"
sh_RSS.Cells(1, 6).Value = "=RSS|'" & gCode & ".T.'!現在値詳細時刻"
sh_RSS.Cells(1, 6).NumberFormatLocal = "h:mm:ss;@"
sh_RSS.Range("A3:A" & sh_RSS.Rows.Count).NumberFormatLocal = "h:mm;@"

Dim r As Range
Set r = sh_RSS.Range(sh_RSS.Cells(2, 1), sh_RSS.Cells(2, 6))
r.Interior.ColorIndex = 5
r.Font.ColorIndex = 2
With r
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With sh_RSS.Columns("A:F").Font
.Name = "MS Pゴシック"
.Size = 36
End With

If IsError(sh_RSS.Cells(1, 6)) = True Then Exit Sub

gNewRow = sh_RSS.Range("E" & sh_RSS.Rows.Count).End(xlUp).Row + 1
sh_RSS.Range("A1").Value = SysTimer.HH & ":" & SysTimer.MM
sh_RSS.Range("B1:D1").Value = sh_RSS.Range("E1").Value

End Sub

Private Sub Clear()

sh_RSS.Cells.Clear
End Sub

'価格が更新されたとき
Private Sub sh_RSS_Calculate()

gVar = sh_RSS.Range("A1:F1")

For i = 2 To 6
If IsError(gVar(1, i)) = True Then Exit Sub
Next


If gVar(1, 3) > gVar(1, 5) Then gVar(1, 3) = gVar(1, 5)
If gVar(1, 4) < gVar(1, 5) Then gVar(1, 4) = gVar(1, 5)

sh_RSS.Range("A1:D1").Value = gVar

End Sub

Private Sub SysTimer_TimeNew()

If gNewRow < 3 Then Exit Sub

'TimeUpイベントで保持した情報を書き込み
sh_RSS.Range("A" & gNewRow & ":E" & gNewRow).Value = gVar

gNewRow = sh_RSS.Range("E" & sh_RSS.Rows.Count).End(xlUp).Row + 1
sh_RSS.Range("A1").Value = SysTimer.HH & ":" & SysTimer.MM
sh_RSS.Range("B1:D1").Value = sh_RSS.Range("E1").Value

End Sub

Private Sub SysTimer_TimeUp()

'価格を保持しておく
gVar = sh_RSS.Range("A1:E1")

End Sub


クラス clsSysTimer を作成し、次のコードを入力

Public MM As String
Public SS As String
Public HH As String
Private sMM As String

Public Event TimeUp()
Public Event TimeNew()
Public Event TimeStart()

Sub TimeLoop()

Do While True
SS = Mid(Format(Now, "hh:mm:ss"), 7, 2)
MM = Mid(Format(Now, "hh:mm:ss"), 4, 2)
HH = Mid(Format(Now, "hh:mm:ss"), 1, 2)

If SS = "00" And MM <> sMM Then RaiseEvent TimeNew
If SS = "59" Then RaiseEvent TimeUp
sMM = MM
DoEvents
Loop


End Sub

Private Sub Class_Initialize()

SS = Mid(Format(Now, "hh:mm:ss"), 7, 2)
MM = Mid(Format(Now, "hh:mm:ss"), 4, 2)
HH = Mid(Format(Now, "hh:mm:ss"), 1, 2)

End Sub


標準モジュールへ次のコードを入力


Private sh_RSS() As clsRSS
Private gIndex As Long
Private SysTimer As clsSysTimer

Sub StartRSS()
Dim sh As Worksheet
On Error GoTo ErrH:

gIndex = 0
Set SysTimer = New clsSysTimer
For Each sh In ThisWorkbook.Worksheets
If UCase(Left(sh.Name, 4)) = "RSS_" Then
ReDim Preserve sh_RSS(gIndex)

Set sh_RSS(gIndex) = New clsRSS
Set sh_RSS(gIndex).SysTimer = SysTimer
sh_RSS(gIndex).OpenRssSheet sh.Name
gIndex = gIndex + 1
End If
Next

SysTimer.TimeLoop

Exit Sub
ErrH:
MsgBox Err.Description

End Sub


以上










楽天証券RSS作り直し

楽天証券のRSSで4本値を作成するVBAを作り直しました。

明日、テストしてみる予定となりました。




ランキングに参加しています。
よかったらポチお願いします。
にほんブログ村 IT技術ブログ VBAへ
にほんブログ村




クラス clsTimer を作成し、次のコードを入力

Public MM As String
Public SS As String
Private sMM As String

Public Event TimeUp()
Public Event TimeNew()
Public Event TimeStart()

Sub TimeLoop(sTime As String)

SS = Mid(Format(sTime, "hh:mm:ss"), 7, 2)
MM = Mid(Format(sTime, "hh:mm:ss"), 4, 2)

If SS = "00" And MM <> sMM Then RaiseEvent TimeNew
If SS = "59" Then RaiseEvent TimeUp
sMM = MM

End Sub

Sub StartLoop(sTime As String)

SS = Mid(Format(sTime, "hh:mm:ss"), 7, 2)
MM = Mid(Format(sTime, "hh:mm:ss"), 4, 2)

RaiseEvent TimeStart

End Sub


以上

楽天証券RSSのテスト

楽天証券のRSSのテストをしていたのだけど

時刻の取り方が違っていることに気づいた・・・

レートの配信時刻もRSSで配信されるみたいで、

その時刻と同期をとらないと意味がない。

というわけで作り直しになりました。

ランキングに参加しています。
よかったらクリックしください。

にほんブログ村 IT技術ブログ VBAへ
にほんブログ村




楽天証券のRSSをテスト中



楽天証券のRSSで分足データ作成をテスト中です。

テストの時間帯が市場が開いていない時間なので、価格データは変動しません。

テストなので問題ありません。

淡々と1分毎にデータが下へ伸びていきます。

実際に市場が開いているときにテストできるのはいつになるか…ですね。




ランキング参加中です。
よかったらポチっお願いします。
にほんブログ村 IT技術ブログ VBAへ
にほんブログ村




テストしているVBAと似たツールの制作依頼をクラウドワークスで発見!
(タイトル:楽天証券提供の楽天RSSを使用した株価取得プログラムの構築)

こういうの依頼する人がいるんですね。

気合を入れて作ってみようかと思う時もあるけど、

領収書発行とかいろいろ面倒なのでROMに徹しています。

こういう制作、受けちゃう人にVBAを教えてもらいたいと思う。






楽天証券のRSSを検討してみる

楽天証券にはRSSというリアルタイムの株価配信機能がある。

これを動かしてみようかと検討しています。

デイトレするとか、リアルタイムに取引するとか、そういうことではなくて

ただ動かしてみたいだけです( ^ω^)・・・





 VBAの型宣言文字

最近まで全く知りませんでした。

あるファイルのコードを見てびっくり!

型宣言文字を使って変数を宣言してありました。

こんなこともできるのかと感心しました。

でも見難い気がするのは私だけでしょうか?

詳しく知りたい方は 型宣言文字 VBA で検索してみてください。



ランキングに参加しています。
よかったらポチっとしてください。
にほんブログ村 IT技術ブログ VBAへ
にほんブログ村
にほんブログ村 IT技術ブログ VBAへ
にほんブログ村
プロフィール

Author:J
VBA 手順書 備忘録

最新記事
最新コメント
月別アーカイブ
カテゴリ
検索フォーム
RSSリンクの表示
リンク
ブロとも申請フォーム

この人とブロともになる

QRコード
QR