スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

Unionで100万セル領域を作成


Sub main()
Dim r As Range
Dim r_Union As Range

For i = 1 To 1000000

Set r = Range("A" & i)

If r_Union Is Nothing Then
Set r_Union = r
Else
Set r_Union = Union(r_Union, r)

End If

Next

MsgBox r_Union.Count
End Sub
スポンサーサイト

楽天証券の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を教えてもらいたいと思う。






にほんブログ村 IT技術ブログ VBAへ
にほんブログ村
プロフィール

J

Author:J
VBA 手順書 備忘録

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

この人とブロともになる

QRコード
QR
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。