ポイント＆フィギュア研究開始

頭悪くて嫌になる今日この頃

取り敢えずチャート描けましたが、考えても解らないものだから、適当にプロシージャ作って動かしてみておかしかったら直してを繰り返し繰り返しやっと完成。１日以上掛かりました(汗

１９９０年から今までのチャート　先ず２２５で

最初の方とプロシージャ

Sub poinntoando()
Dim Rp As Range '終値
Dim Tanni As Single
Dim Jg As Long
Dim Tk As Long
Dim Ys As Long
Dim Migi As Long
Jg = 1 '初期値
Tk = 39000 '初期値
Migi = 7 '初期値
Tanni = Range("i2").Value
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each Rp In Selection
With Rp
If Int(.Value / Tanni) * Tanni >= Ys + 3 * Tanni And Jg = -1 Then
Range("h2").Copy
Cells(4 + (39100 - Tk) / Tanni, Migi).Resize((Tk - Ys) / 100, 1).PasteSpecial
Migi = Migi + 1
Jg = 1
Tk = Int(.Value / Tanni) * Tanni
.Offset(, 2).Value = Tk
ElseIf Int(.Value / Tanni) * Tanni >= Tk And Jg = 1 Then
Tk = Int(.Value / Tanni) * Tanni
.Offset(, 2).Value = Tk
ElseIf Int(.Value / Tanni) * Tanni < Tk And Int(.Value / Tanni) * Tanni > Tk - 3 * Tanni And Jg = 1 Then
.Offset(, 2).Value = Tk
ElseIf Int(.Value / Tanni) * Tanni <= Tk - 3 * Tanni And Jg = 1 Then
If Ys <> 0 Then
Range("g2").Copy
Cells(4 + (39000 - Tk) / Tanni, Migi).Resize((Tk - Ys) / 100, 1).PasteSpecial
Migi = Migi + 1
End If
Jg = -1
Ys = Int(.Value / Tanni) * Tanni
.Offset(, 2).Value = Ys
ElseIf Int(.Value / Tanni) * Tanni <= Ys And Jg = -1 Then
Ys = Int(.Value / Tanni) * Tanni
.Offset(, 2).Value = Ys
ElseIf Int(.Value / Tanni) * Tanni > Ys And Int(.Value / Tanni) * Tanni < Ys + 3 * Tanni And Jg = -1 Then
.Offset(, 2).Value = Ys
End If
.Offset(, 1).Value = Jg
End With
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

これ使って何か出来ないか研究してみます

通貨ペア同士の日時を揃える

ＮＴ倍率を使った良いシステムが出来たのに味をしめ応用編の研究中

ちなみにＴＯＰＩＸとドル円は駄目でした

じゃあ通貨ペア同士って事で基本のユーロドルとドル円から

先ずやるのはデータが欠けてないかチェック

絶対出るんです

上のように週末や週明け欠けてることがよく有ります

それで下のように修正するマクロ

Sub 挿入()
Dim Rp As Range 'rpは日付
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each Rp In Selection
With Rp
If .Offset(, 1).Value < .Offset(, 8).Value Then
.Offset(-1, 7).Resize(1, 6).Copy
.Offset(, 7).Insert shift:=xlDown
.Offset(, 8).Value = .Offset(, 1).Value
.Interior.Color = 65535
ElseIf .Offset(, 1).Value > .Offset(, 8).Value Then
.Offset(-1).Resize(1, 6).Copy
.Insert shift:=xlDown
.Offset(, 1).Value = .Offset(, 8).Value
.Interior.Color = 65535
End If
End With
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

じゃあまた

鈎足チャートの研究終了

シストレでは使いもんにならない模様

裁量で使えるのかも疑問?

左の100ｋから300uは鈎が折れたところでエントリーしトレーリングストップ決済

右は色が変わったところでエントリーしトレーリングストップ決済

0１～17年迄の損益と15倍になったという16年だけの損益

いろんな向きや色の組み合わせで使えそうなパターンがないかと探してみましたが殆ど有りませんでした

9時スタート8時間足の終値を使ったので教科書通りではありませんが変わらないでしょう

結局適当な他のブレイクアウトでも、トレーリングストップを使えば同じような結果が出るのではないかと

もうひとつ損切りに8時間後決済で計算してみました

少しは良いのあるかもとやってみたのですが

サッパリでした

鈎足チャートの研究開始

１年で１０万が１５０万にとかいう凄いのが有り

ほんまかいな？と最初から辿ってみると案の定眉唾

２０万になるところまで見て解ったがレバレッジ１００倍のフルレバかよと

でもまあスイングのシステム作りたかったし有効かも？ということでやり出しました

随分悩んだのでマクロ置いとこうと

Sub 向き色()
Dim Rp As Range 'rpは日付
Dim Ow As Single
Dim Y1 As Single, Y15 As Single, Y2 As Single, Y3 As Single '安値
Dim Yz1 As Single, Yz15 As Single, Yz2 As Single, Yz3 As Single '前回の安値
Y1 = 114.55: Y15 = 114.55: Y2 = 114.55: Y3 = 114.55 '初期値
Dim T1 As Single, T15 As Single, T2 As Single, T3 As Single
Dim Tz1 As Single, Tz15 As Single, Tz2 As Single, Tz3 As Single
T1 = 114.55: T15 = 114.55: T2 = 114.55: T3 = 114.55
Dim M1 As Long, M15 As Long, M2 As Long, M3 As Long '向き
Dim I1 As Long, I15 As Long, I2 As Long, I3 As Long '色
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each Rp In Selection
With Rp
Ow = .Offset(, 5).Value
If M1 <= 0 And Ow >= Y1 + 1 Then
M1 = 1
Tz1 = T1
T1 = Ow
ElseIf M1 >= 0 And Ow <= T1 - 1 Then
M1 = -1
Yz1 = Y1
Y1 = Ow
ElseIf M1 > 0 And Ow > T1 Then
T1 = Ow
ElseIf M1 < 0 And Ow < Y1 Then
Y1 = Ow
End If
If I1 >= 0 And Ow < Yz1 Then
I1 = -1
ElseIf I1 <= 0 And Ow > Tz1 Then
I1 = 1
End If
If M15 <= 0 And Ow >= Y15 + 1.5 Then
M15 = 1
Tz15 = T15
T15 = Ow
ElseIf M15 >= 0 And Ow <= T15 - 1.5 Then
M15 = -1
Yz15 = Y15
Y15 = Ow
ElseIf M15 > 0 And Ow > T15 Then
T15 = Ow
ElseIf M15 < 0 And Ow < Y15 Then
Y15 = Ow
End If
If I15 >= 0 And Ow < Yz15 Then
I15 = -1
ElseIf I15 <= 0 And Ow > Tz15 Then
I15 = 1
End If
If M2 <= 0 And Ow >= Y2 + 2 Then
M2 = 1
Tz2 = T2
T2 = Ow
ElseIf M2 >= 0 And Ow <= T2 - 2 Then
M2 = -1
Yz2 = Y2
Y2 = Ow
ElseIf M2 > 0 And Ow > T2 Then
T2 = Ow
ElseIf M2 < 0 And Ow < Y2 Then
Y2 = Ow
End If
If I2 >= 0 And Ow < Yz2 Then
I2 = -1
ElseIf I2 <= 0 And Ow > Tz2 Then
I2 = 1
End If
If M3 <= 0 And Ow >= Y3 + 3 Then
M3 = 1
Tz3 = T3
T3 = Ow
ElseIf M3 >= 0 And Ow <= T3 - 3 Then
M3 = -1
Yz3 = Y3
Y3 = Ow
ElseIf M3 > 0 And Ow > T3 Then
T3 = Ow
ElseIf M3 < 0 And Ow < Y3 Then
Y3 = Ow
End If
If I3 >= 0 And Ow < Yz3 Then
I3 = -1
ElseIf I3 <= 0 And Ow > Tz3 Then
I3 = 1
End If
.Offset(, 6).Value = M1
.Offset(, 7).Value = I1
.Offset(, 8).Value = M15
.Offset(, 9).Value = I15
.Offset(, 10).Value = M2
.Offset(, 11).Value = I2
.Offset(, 12).Value = M3
.Offset(, 13).Value = I3
End With
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

フィボナッチ数列を計算するマクロ

頭の体操にトレーダーらしくフィボナッチに挑戦

やはり頭弱いもんだから図描いたり色々悩みまくったが結局解らなかった

それで適当にプロシージャああでも無いこうでも無いやって完成

理解はあとでゆっくりlol

Sub fibo()
Dim P As Long
Dim F As Long
Dim F1 As Long
Dim F2 As Long
F1 = 1
For P = 1 To 10
F1 = F1 + F2
F2 = F
F = F1
Range("a" & P).Value = F
Next
End Sub

丸を描くマクロ

少し頭の体操にとやり出したが、頭弱いもんで３０分以上かかってしまった

Cellsって普段使わないから.Offsetでやってみたり･･･

こんなのには非常に便利

Sub maru()
Dim x As Long
Dim y As Long
For x = 4 To 260
For y = 4 To 260
If Int(Sqr((x - 132) * (x - 132) + (y - 132) * (y - 132))) = 128 Then
Cells(x, y).Interior.ColorIndex = 1
End If
Next
Next
End Sub

４本値並べて日時が狂ってたら挿入するやつ

この頃ＮＴ倍率に興味が出てやってるところ

日経とＴＯＰＩＸ並べて同日時で比較したいのだが、日時がズレる場合が有るのよね～

通貨ペア同士の比較でも常に有ることだし基本として置いとこう

これは2011／2／14～11／18で225先物は昼休みが無くなったのにＴＯＰＩＸの方には有る

それを修正するのに

225の4本値までをコピー。ＴＯＰＩＸに挿入。１１時の４本値を挿入したセルに貼付

をこれに

マクロの自動記録

Sub Macro2()
Range("A49444:F49448").Select
Application.CutCopyMode = False
Selection.Copy
Range("H49444").Select
Selection.Insert Shift:=xlDown
Range("J49443:M49443").Select
Application.CutCopyMode = False
Selection.Copy
Range("J49444:M49448").Select
ActiveSheet.Paste
End Sub

選択した範囲で使えるように整理した

Sub 挿入()
Dim Rp As Range 'rpは日付
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each Rp In Selection
With Rp
If .Offset(, 1).Value = 0.46875 Then
.Resize(5, 6).Copy
.Offset(, 7).Insert Shift:=xlDown
.Offset(-1, 9).Resize(1, 4).Copy
.Offset(, 9).Resize(5, 4).PasteSpecial
End If
End With
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub