2通貨目追加

[FXシステムトレード] ブログ村キーワード

2通貨目の追加をするプログラムを作りました。

こんな感じです。

Dim lastrow(100) As Long
Dim Youbi As Integer
Dim ZikanB As Integer
Dim ZikanE As Integer
Dim HunB As Integer
Dim HunE As Integer
Dim Hajimari As Single
Dim Owari As Single
Dim HajimariV As Single
Dim OwariV As Single
Dim ownBookName As String
Dim BookName(10) As String
Dim WBK As Workbook
Dim G As Integer
Dim f1 As String
Dim f2 As String
Dim wb As Workbook
Sub main()

Set WBK = ThisWorkbook ' 自ブック
ownBookName = WBK.Name ' 自ブック名
ChDir "C:\Users\wak\Desktop\書庫\AutoForexite\HistoricalData" '\AUDJPY\1min"
f1 = Application.GetOpenFilename("テキスト ファイル (*.txt), *.txt", , "１回目")
If f1 = "False" Then
MsgBox "キャンセル"
Exit Sub
End If
ChDir "C:\Users\wak\Desktop\書庫\AutoForexite\HistoricalData" '\AUDJPY\1min"
f2 = Application.GetOpenFilename("テキスト ファイル (*.txt), *.txt", , "２回目")
If f2 = "False" Then
MsgBox "キャンセル"
Exit Sub
End If

MsgBox f1 & " を開きます"
'Workbooks.OpenText Filename:=f1, DataType:=xlDelimited, comma:=True
Dim buf As String, n As Long
Open f1 For Input As #1
Do Until EOF(1)

Line Input #1, buf
n = n + 1
Cells(n, 1) = buf
Dim i As Long, tmp As Variant
tmp = Split(Cells(n, 1), ",")

Cells(n, 1) = tmp(0)
Cells(n, 2) = tmp(1)
Cells(n, 3) = tmp(2)
Cells(n, 4) = tmp(3)
Cells(n, 5) = tmp(4)
Cells(n, 6) = tmp(5)

Loop
Close #1

'Set wb = Workbooks.Add
MsgBox f2 & " を開きます"
'Workbooks.OpenText Filename:=f2, DataType:=xlDelimited, comma:=True
Open f2 For Input As #1
n = 0
Do Until EOF(1)

Line Input #1, buf
n = n + 1
Cells(n, 10) = buf
tmp = Split(Cells(n, 10), ",")

Cells(n, 10) = tmp(0)
Cells(n, 11) = tmp(1)
Cells(n, 12) = tmp(2)
Cells(n, 13) = tmp(3)
Cells(n, 14) = tmp(4)
Cells(n, 15) = tmp(5)

Loop
Close #1
'For n = 1 To Workbooks.Count
' BookName(n) = Workbooks(n).Name
' If BookName(n) <> ownBookName Then
' G = n
' End If
'Next n


'Workbooks(BookName(G)).Activate
lastrow(0) = Cells(1, 1).End(xlDown).Row 'MA40最終行
Youbi = InputBox("何曜日を抽出しますか？（月＝1：火＝2：水＝3：木＝4：金＝5")
ZikanB = InputBox("何時からを抽出しますか？（0〜23)")
HunB = InputBox("何分から抽出しますか？（0〜59)")
ZikanE = InputBox("何時までを抽出しますか？(0〜23）")
HunE = InputBox("何分まで抽出しますか？（0〜59)")

Hajimari = 0.000694445 * 60 * ZikanB + 0.000694445 * HunB
Owari = 0.000694445 * 60 * ZikanE + 0.000694445 * HunE

For i = 1 To lastrow(0)
Cells(i, 7) = WorksheetFunction.Weekday(Cells(i, 1), 1)
Cells(i, 8) = Month(Cells(i, 1))
Next

For i = 1 To lastrow(0)
If Cells(i, 8) > 2 And Cells(i, 8) < 11 Then '夏時間対応
HajimariV = Hajimari - (0.000694445 * 60)
OwariV = Owari - (0.000694445 * 60)
Else: HajimariV = Hajimari
OwariV = Owari
End If
If i > 31833 Then
i = i
End If
If Cells(i, 7) <> Youbi Or Cells(i, 2) < HajimariV Or Cells(i, 2) > OwariV Then

For ii = i To lastrow(0)
If Cells(ii, 8) > 2 And Cells(ii, 8) < 11 Then '夏時間対応
HajimariV = Hajimari - (0.000694445 * 60)
OwariV = Owari - (0.000694445 * 60)
Else: HajimariV = Hajimari
OwariV = Owari
End If
If ii > 35000 Then
ii = ii
End If
If Cells(ii, 7) = Youbi And Cells(ii, 2) > HajimariV And Cells(ii, 2) < OwariV Then
Workbooks(BookName(G)).Activate
Range("A" & i, "H" & ii - 2).Select
Selection.Clear
i = ii + 1
Exit For
End If
Next
End If
Next

For k = 1 To lastrow(0)
If Cells(k, 1) = "" Then
For kk = k To lastrow(0)
If Cells(kk, 1) <> "" Then
Exit For
End If
Next
Rows(k & ":" & kk - 1).Select
Selection.Delete shift:=xlUp
lastrow(0) = lastrow(0) - (kk - k)
If k > lastrow(0) Then
Exit For
End If
'IL = IL + 1
End If
Next k

lastrow(0) = Cells(1, 1).End(xlDown).Row 'MA40最終行
For i = 1 To lastrow(0)
If Cells(i, 8) > 2 And Cells(i, 8) < 11 Then '夏時間対応
HajimariV = Hajimari - (0.000694445 * 60)
OwariV = Owari - (0.000694445 * 60)
Else: HajimariV = Hajimari
OwariV = Owari
End If
If i > 189 Then
i = i
End If
If Cells(i, 7) <> Youbi Or Cells(i, 2) > OwariV Then

For ii = i To lastrow(0)
Workbooks(BookName(G)).Activate
Range("A" & i, "H" & lastrow(0)).Select
Selection.Clear
i = ii + 1
'Exit For
GoTo Syuuryou
Next
End If
Next
Syuuryou:

End Sub


Split関数というのを使って、カンマ区切りのテキストファイルを

ひとつひとつのセルに放り込みます。

面倒ですが、これが一番いいだろうと聞きましたのでそれで

作りました。

で、うまく行ったんですが、新たに問題が浮上。

なんと、歯抜けデータが存在します(；・∀・)

抜けデータがある時間帯が朝早いようなので、

おそらく、取引がなかったのであろうと推察します。

約定がないから値がつかない。

これ、どうするかなぁ。

使う箇所のみ抽出して、そこに歯抜けがあったら上の行を

コピーするようにしますかね。時間がそろわないと

比べられないですよね。

加工する前に処理をすると重くなりそうだしな。ふむ。。。



今日の1位はどこかしら
↓　↓　↓　↓

にほんブログ村

タグ：FX サヤ取り マクロ エクセル