スポンサーサイト

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

Swapデータの取得(Sazaを利用)

Sazaのホームページに載っているスワップテーブルを取得するマクロ。

- curr() ・・・ 通貨ペア名
- sh(0~n-1) ・・・ ショートのスワップ(10000通貨単位)
- lg(0~n-1) ・・・ ロングのスワップ(10000通貨単位)
- n ・・・ 取得したデータ数

---------------------------------------------------
---------------------------------------------------

'-- mySleepで使うファンクション --
Private Declare Function GetTickCount Lib "kernel32" () As Long

Sub GetSwap_fromSAZA()

Dim web As WebBrowser

Set web = form.web
form.Show vbModeless

web.Navigate "http://www.saza-investment.com/support/swap_table.html"
Call myWebStay(web)

Dim doc As String
doc = web.Document.Body.innerHTML

Dim chk1 As Long, chk2 As Long
Dim curr() As String, sh() As Double, lg() As Double, n As Integer

n = 0
chk2 = mySearch("USD/JPY", doc, 1)
chk2 = mySearch("全128通貨スワップレート", doc, chk2)
Do
chk1 = mySearch("", doc, chk2)
If chk1 = 0 Then Exit Do

ReDim Preserve curr(n): ReDim Preserve sh(n): ReDim Preserve lg(n)
curr(n) = Mid(doc, chk1 + 19, 7)

chk1 = mySearch("", doc, chk1)
chk2 = mySearch("", doc, chk1)
sh(n) = Val(Mid(doc, chk1 + 20, chk2 - chk1 - 20 - 3)) '-3は通貨表示分
sh(n) = sh(n) / 10

chk1 = mySearch("", doc, chk2)
chk2 = mySearch("", doc, chk1)
lg(n) = Val(Mid(doc, chk1 + 19, chk2 - chk1 - 19 - 3)) '-3は通貨表示分
lg(n) = lg(n) / 10

n = n + 1
Loop

MsgBox n

form.Hide

'-- Excelの場合、以下で表示 --
Application.ScreenUpdating = False
Dim i As Long
For i = 0 To n - 1
Range("C" & i + 11) = curr(i)
Range("D" & i + 11) = sh(i)
Range("E" & i + 11) = lg(i)
Next i
Application.ScreenUpdating = True
End Sub

'----------------------------------------------
'--- 汎用Function -----------------------------
'----------------------------------------------
Private Function myWebStay(web As WebBrowser) As String

Do Until web.Busy = False
DoEvents
Loop
Do Until Not web.Document Is Nothing
DoEvents
Loop
Do Until web.Document.ReadyState = "complete"
DoEvents
Loop
Call mySleep(200)
myWebStay = web.LocationURL

End Function

Sub mySleep(ms As Long)
Dim tm As Long
tm = GetTickCount() + ms
Do While GetTickCount() < tm
DoEvents
Debug.Print GetTickCount
Loop
End Sub

Private Function mySearch(key, txt, nStart As Long) As Long
Dim i As Long

For i = nStart To Len(txt)
If UCase(Mid(txt, i, Len(key))) = UCase(key) Then
mySearch = i
Exit Function
End If
Next i
mySearch = 0
End Function


スポンサーサイト

WEB:完全に表示されるまで待つ

関連キーワード:webbrowser, ReadyState

’-- mySleep関数で使っているGetTickCount関数 --
Private Declare Function GetTickCount Lib "kernel32" () As Long

Sub test()
Dim web As WebBrowser
Set web = form.web
web.Navigate "http://www.***"
Call myWebStay(web)
End Sub

Private Function myWebStay(web As WebBrowser) As String

Do Until web.Busy = False
DoEvents
Loop
Do Until Not web.Document Is Nothing
DoEvents
Loop
Do Until web.Document.ReadyState = "complete"
DoEvents
Loop
'念のため200ミリ秒待つ
Call mySleep(200)
myWebStay = web.LocationURL

End Function

Sub mySleep(ms As Long)
Dim tm As Long
tm = GetTickCount() + ms
Do While GetTickCount() < tm
DoEvents
Debug.Print GetTickCount
Loop
End Sub

自作wait関数

関連キーワード:sleep,ミリ秒

Private Declare Function GetTickCount Lib "kernel32" () As Long

Sub test()
Call mySleep(1000)
End Sub

'-- msミリ秒ウェイとする --
Sub mySleep(ms As Long)
Dim tm As Long
tm = GetTickCount() + ms
Do While GetTickCount() < tm
DoEvents
Debug.Print GetTickCount
Loop
End Sub

ファイルコピー(FileSystemObject使用)

set fso = new filesystemobject
fso.copyfile コピー元ファイル名, コピー先ファイル名, 上書き確認不要flag
set fso = nothing
※ [Microsoft Scripting Runtime]を参照設定すること

Accessで確認メッセージを消す

DoCmd.SetWarnings False

最適FXポートフォリオを構築するExcelBook

関連キーワード: FX、Excel、VBA、ポートフォリオ、Swap派

Swap_080817.xls

仕様・使い方:

■データ更新について(HistoricalData)■
HistoricalDataに、HistoricalDataを貼る
※ HistoricalDataの取得は、を使うJPYBase、CapitalGain、SwapGain、評価シートの行を、HistoricalDataのデータが入っている行数までコピペ

■データ更新について(Spread)■
を使う

■データ更新について(Swap)■
GFTのホームページから"円貨建て"のPDFを元にして、緑色のセルをアップデート
・PDFの処理方法・全体をコピーして、新たに空Bookを作り、そこに貼り付け・データ区切り位置で、スペースを区切り文字として処理
・文字列行(途中にも入っている)を削除(変にコピペされる行もあるので、要注意)
・A列~E列の値を、Swapシートの緑字のところに貼り付け

■分析対象外通貨の選択(Swapシート)■
・M列(利回り)やT列(SpreadをSwapで回収するには何日かかるか)などを元に、使用不可通貨を選択し、V列にマーク(1を入力)する
・参考基準=利回り>1%、コスト回収<15日

■現ポジション取得■
・Currentシートのボタンを押す

■最適ポートフォリオの構築■
・Strategyシートの各種ボタンで調整・分析

■作業・計算シート■
HistoricalData・JPYBase・CapitalGain・SwapGain・評価シートは、作業用。手を入れるのは、データ更新時くらい

GFTを操作するDLL

関連キーワード: DLL, GFT, VBA

GFTControl.dll

GFTの携帯用Webを使って、GFTの操作をするためのDLL

GFTのSpreadを取得するExcelマクロ

関連キーワード: VBA, Spread, Bid, Ask, GFT

GFT_Spread取得.xls

仕様
・GFTの携帯用Webページを使ってSpread(Bid/Ask)を取得する。
・A列に書かれてある通貨が対象
・B列~D列にデータを貼る(D列は単なる引き算関数)
・自作DLL(GFTControl.dll)を使っているので、要注意(System32フォルダに入れてる)

FXのHistorical Data(週次)を取得するExcel Macro

関連キーワード:Historical Data, FX, 週次, VBA

ファイル
HistoricalData.xls

仕様
・http://fx.sauder.ubc.ca/data.htmlからデータ取得する。
・A列に書かれてある通貨が対象
・B列~D列にデータを貼る
・すでに取得済みのデータは、貼らない
・すでに取得済みのデータを取り直したいときは、その行を削除してからマクロ実行
・取得してくる日付はデフォルト分だが、もし変えたいとき(2005年とか)は、モジュール(GetHistoricalDatafromWeb)の『If form.webからデータ取得(prod1, prod2) = True Then』行の部分を次のように変更する。
If form.webからデータ取得(prod1, prod2,2003,2006) = True Then

使い方
・ボタン押す

備考
Webのページ読み込み待ち部分ですが、遅めにしてます。ReadyState=READYSTATE_Completeの後でも読み込み不十分なときがあり(なぜだか不明)、そんなトラブルを避けるためバッファ持たせてます。
もしうまいやり方を知っている人がいれば教えてください。

配列の初期化

関連キーワード:redim

redim 変数名(0)

※redimで空っぽを宣言すると、今まで入っていたものが初期化される

WebBrowserのチェックボックスにチェックを入れる

関連キーワード:WebBrowser CheckBox

web.Document.All.[名前]([何番目?]).Checked = True

サンプル
chk = 0: n = 0
Do
chk = mySearch("type=checkbox", txt, chk + 1)
If chk = 0 Then Exit Do
web.Document.All.instrument_id(n).Checked = True
n = n + 1
Loop

※ mySearch・・・txtの何文字目に"---"があるかを返す。

文字の置換Function

s : 大本の本文
org : 置換される文字
rep : 置換する文字

Public Function RepStr(ByVal s As String, ByVal org As String, ByVal rep As String) As String
Dim a As String
Dim j, i, k As Integer

a = s
k = Len(org) - 1
j = Len(rep)
i = 1 - j
Do
i = InStr(i + j, a, org)
If i > 0 Then a = Left(a, i - 1) & rep & Right(a, Len(a) - i - k)
Loop Until i = 0

RepStr = a

End Function

サマータイム(Daylightsaving)のチェックプログラム

Function IsDaylightSavingTime(ByVal dt As Date) As Boolean
Dim d1 As Date, d2 As Date

If Year(dt) <= 2007 Then
If (#4/1/2001# <= dt And dt <= #10/28/2001#) _
Or (#4/7/2002# <= dt And dt <= #10/27/2002#) _
Or (#4/6/2003# <= dt And dt <= #10/26/2003#) _
Or (#4/4/2004# <= dt And dt <= #10/31/2004#) _
Or (#4/3/2005# <= dt And dt <= #10/30/2005#) _
Or (#4/2/2006# <= dt And dt <= #10/29/2006#) _
Or (#3/11/2007# <= dt And dt <= #11/4/2007#) _
Then IsDaylightSavingTime = True _
Else IsDaylightSavingTime = False
Else
d1 = CDate(Year(dt) & "/3/1").AddDays(-1)
d2 = CDate(Year(dt) & "/11/1").AddDays(-1)
d1 = d1.AddDays(-Weekday(d1) + 1 + 14).AddHours(2)
d2 = d2.AddDays(-Weekday(d1) + 1 + 7).AddHours(2)

If d1 <= dt And dt <= d2 _
Then IsDaylightSavingTime = True _
Else IsDaylightSavingTime = False
End If

End Function

VBAに、テーブルからデータを取得

Dim currs() As String, n As Integer
Dim adoCON As ADODB.Connection
Dim adoRS As ADODB.Recordset

'DBへの接続
Set adoCON = Application.CurrentProject.Connection
Set adoRS = adoCON.Execute("select * from Currencies")

n = 0
'最終レコードまで順読み込みを行う
Do Until adoRS.EOF = True
ReDim Preserve currs(n)
currs(n) = adoRS("Currency") 'DBより情報取得(Currencyは項目名)

adoRS.MoveNext 'レコードの順読み
n = n + 1
Loop

'後処理
adoRS.Close
adoCON.Close
Set adoRS = Nothing
Set adoCON = Nothing

SQLを発行するVBA

'接続用変数
Dim adoCON As ADODB.Connection
Set adoCON = Application.CurrentProject.Connection

'SQLの発行
sSql = ***
DoCmd.RunSQL sSql

'後処理
adoCON.Close
Set adoCON = Nothing



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