スポンサーサイト

上記の広告は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


スポンサーサイト

トラックバック

コメント

コメントを残す

Secret



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