For targetWindow in ALL_WIN_ID //ログインボタンを探す(ボタンの大きさでしか判断できなかったw) If STATUS(targetWindow, ST_WIDTH) = 107 and STATUS(targetWindow, ST_HEIGHT) = 37 then //RETURN送ってもダメ //SCKEY(targetWindow, VK_RETURN)
A 全て手動で 1.ネットトレーダー株365を起動→2.エクセルを起動+同マクロを含むファイルを開く→3.マクロ実行 とすると問題なく転記することができました。 こちらを自動化するためにVBSを書いて B. 1,手動でネットトレーダー株365を起動→ 2.VBSにてエクセルを起動+同マクロを含むファイルを開く3.同VBSにてマクロ実行 とするとうまく転記できません。 動きを見てると既存のデータを消した後に再度データが埋まらずにそのままマクロが走ってしまい、最新データを取得できない様です。
A 全て手動で 1.ネットトレーダー株365を起動→2.エクセルを起動+同マクロを含むファイルを開く→3.マクロ実行 とすると問題なく転記することができました。 こちらを自動化するためにVBSを書いて B. 1,手動でネットトレーダー株365を起動→ 2.VBSにてエクセルを起動+同マクロを含むファイルを開く3.同VBSにてマクロ実行 とするとうまく転記できません。 動きを見てると既存のデータを消した後に再度データが埋まらずにそのままマクロが走ってしまい、最新データを取得できない様です。
VBS ========================================== Option Explicit Dim objShell
Set objShell = CreateObject("WScript.Shell") objShell.Run "excel F:\SynologyDrive\myfile\個人\自動起動.xlsm"
set objShell = nothing ==========================================
Excel (ThisWookbook に追加してください) ========================================== Private Sub Workbook_Open() Call Run("時間記入") End Sub ==========================================
現状整理の件です。windows11でオフィスはちょっと頂いた確認方法ではないのですが、アプリと機能をみるとoffice professional plus2016となっております。いろいろやってみてはいてアドイン表記はできてます。ただ、前にも記載している岡三RSSのみエクセルのファイル オプションからのアドインに表示されてないです。たぶんこれが原因なんでしょうが。他のcom2とかは表示されチェックも入れてます。さらにいうとアプリと機能のところ確認すると岡三RSS 岡三RSSエクセルアドインは表示されておりインストールはされてるかんじではあります。それと岡三エクセルアドインに関してはアプリと機能で変更で修復をかけてみましたが、変化ありません。どうしましょぅか?前のPCみると岡三rssはアドインのところで表示されているのですが、今回のだとこれだけ表示されてこないのでここが原因かとは思うのですが。すみません。もう少しお知恵をお願いします。
2022年05月04日
jj
それとエクセルアドイン確認してみてアクティブなアドインアクティブでないを両方みても岡三RSSは表示されてません。 oson com addin 2はアクティブで表示されていてエクセルでもチェック入ってます。
Public Sub StartProc() nextTime = Now + TimeValue(""00:00:01"") Call Application.OnTime(nextTime, ""MainProc"") End Sub
Public Sub MainProc() Sheet1.Range(""A1"").Value = Range(""A1"").Value + 1 nextTime = Now + TimeValue(""00:00:01"") Call Application.OnTime(nextTime, ""MainProc"") End Sub
Public Sub EndProc() Call Application.OnTime(nextTime, ""MainProc"", , False) End Sub
関数のマニュアル「function_manual.pdf」の 「先物 OP 保有情報」を見ています。 ここに「決済注文可否フラグ」という項目はあります。 関数「FOPPOSITION」の第一引数「取得項目名」で設定できる項目名一覧は「先物 OP 保有情報」に記載している項目名ではないということでしょうか？
Sub 注文可能可否チェック() If CommandBars("岡三RSS2").Controls(4).TooltipText = "注文できません" Then Cells(1, 1) = "注文不可" End If If CommandBars("岡三RSS2").Controls(4).TooltipText = "注文可能" Then Cells(1, 1) = "注文可能" End If End Sub
================================ Private Type OHLC Time As Date Open As Long High As Long Low As Long Close As Long End Type Private OHLCList() As OHLC
'データ成型後取り込み Private Sub CommandButton1_Click() Dim RowIdx As Integer Dim OHLCIdx As Integer
OHLCIdx = 0 For RowIdx = 2 To 392 ReDim Preserve OHLCList(OHLCIdx)
(シートモジュール) Private Sub Worksheet_Change Dim i as integer For i ＝3 to 25 if Cells(i,9)＜=-5000 then “評価損益額はCells(3.9)から記入 if cells(i, 1)=“買" then “建玉の売買の別は,Cells(3,1)から記入 Call 決済売 Else Call 決済買 End if End if
if Cells(i,9)>=5000 then if cells(i, 1)=“買" then Call 決済売 Else Call 決済買 End if End if
Next End Sub
＊損切り、利益確定ともそれぞれ-5000円 、5000円としています。 ＊＊決済売,買とも標準モジュールに於て、 sub 決済売 () kessaiuri=fneworder(成行・決裁売) End Sub をそれぞれ作成しています。 ＊＊＊3~25行まで保有の注文までの処理としています。
Private Sub Worksheet_Change() Dim i As Integer For i = 3 To 25 If Cells(i, 9) <= -5000 Then '評価損益額はCells(3.9)から記入 If Cells(i, 1) = "買" Then '建玉の売買の別は,Cells(3,1)から記入 Call 決済売 Else Call 決済買 End If End If
If Cells(i, 9) >= 5000 Then If Cells(i, 1) = "買" Then Call 決済売 Else Call 決済買 End If End If
Next End Sub
'損切り、利益確定ともそれぞれ-5000円 、5000円としています。 '済売,買とも標準モジュールに於て、 Sub 決済売() 'kessaiuri=fneworder(成行・決裁売) End Sub Sub 決済買() 'kessaiuri=fneworder(成行・決裁売) End Sub 'をそれぞれ作成しています｡ '＊＊＊3~25行まで保有の注文までの処理としています。
以上
2017年05月26日
おおた
小笠原聖史 様 早速のご教示感謝いたします。 ご指示通りもう一度、マクロを動かしました。しかし,“プロシーシ"ャの宣言が、イベント又はプロシージャの定義と一致していません。“の表示がでました。 どうも,周辺あたりのcall決済売等が、間違えている可能性があります。厚かましいお願いでございますが,下記をチェック願えれば、幸甚でございます。 FOPPOS1T10Nは、sheet6(決済)で開いています。sheet6(決済)のシートモジュールに.Pnvate sub worksheet changeを書ぃています。sub 決済売()は次の様に、標準モジュールに書いています。
sub 決済売() Dim kessainri as string sheets(“決済“).select cells(1、2)=Cells(1,6) “建玉番号 kessaiuri=Fneworder() cells(1,4)=Cells(1,4)+ 1
小笠原聖史 様 早速のご回答お礼申し上げます。 新規買いの発注マクロを詳細にお教え頂き有難うございます。FOPPOS10Nの評価損益額にてCOCを行いたく考えていますが,主題のシートモジュールに記したPrivate sub worksheet changeの中の“call 決済売“ で呼び出される“sub 決済売() “の建玉番号を記入するところが良く分かりません。 できましたら,下記の＊＊を追加したPrivate Sub Worksheet_Change()及びsub 決済売() をチェック願えれば、幸甚でございます。 なお、FOPPOS1T10Nは、sheet6(決済)で開いています。 (前回の問い合せ時のコードからは修正しています)
Private Sub Worksheet_Change() Dim i As Integer For i = 3 To 25 If Cells(i, 9) <= -5000 Then '評価損益額はCells(3.9)から記入 ＊＊Cells(1,8)=Cells(i,6) ′建玉番号です。 If Cells(i, 1) = "買" Then '建玉の売買の別は,Cells(3,1)から記入 Call 決済売 Else Call 決済買 End If End If ＊＊6列にFOPPOS1T10Nの建玉番号を表示。Cells(i,6)は、建玉番号を示 します。利益確定の部分も同様に考え、ここでは省略しています。
sub 決済売() “標準モジュールに記入 Dim kessaiuri as string sheets(“決済“).select kessaiuri=Fneworder() cells(1,4)=Cells(1,4)+ 1 “発注ⅠD
Sub 決済発注() Dim i As Integer Dim 建玉NO As String Dim 発注ID As String For i = 3 To 25 If Cells(i, 9) <= -5000 Then 建玉NO = Cells(i, 6) 発注ID = Cells(i, 10) If Cells(i, 1) = "買" Then Call 決済売(建玉NO, 発注ID) Else Call 決済買(建玉NO, 発注ID) End If End If Next End Sub Sub 決済売(建玉NO As String, 発注ID As String) Rs = FNEWORDER("N225mini", "201706", 2, 建玉NO, "1", 1, 0, 0, 1, 0, 1, "", "password", 発注ID, 1, "trade10", "", "") End Sub Sub 決済買(建玉NO As String, 発注ID As String) Rb = FNEWORDER("N225mini", "201706", 2, 建玉NO, "1", 3, 0, 0, 1, 0, 1, "", "Password", 発注ID, 1, "trade10", "", "") End Sub
2017年05月29日
おおた
小笠原聖史 様 朝一番の丁寧かつ完璧なご回答に対し,お返事遅れまして申し訳ございません。一つ初歩的な質問がございます。 “発注IDは、全注文でユニークになるように設定"しろのことでございますが,新規の発注IDに対し1を加えて、決済の発注IDにする場合,下記のコードで宣しいのでしょうか? (新規の発注ID発行も売買とも、Cells(1.1)= Cells(1,1)＋１とし1を加えていきます) Sub 決済発注() Dim i As Integer Dim 建玉NO As String Dim 発注ID As String For i = 3 To 25 If Cells(i, 9) <= -5000 Then 建玉NO = Cells(i, 6) ＊＊発注ID = Cells(i, 10)+1 If Cells(i, 1) = "買" Then Call 決済売(建玉NO, 発注ID) Else Call 決済買(建玉NO, 発注ID) End If End If Next End Sub ＊＊ 発注ID = Cells(i, 10)+1 とし, 1を加えていく。
Sub 保有情報取得関数OPPOS1TI0Nに表示される評価損益額を使ったOCO注文() If Cells(1, 15) <> "" Then MsgBox "決済発注判定を修了します。" Exit Sub End If Call 決済発注判定 反復時刻 = TimeValue(Now) + TimeValue("00:00:01") Application.OnTime 反復時刻, "保有情報取得関数OPPOS1TI0Nに表示される評価損益額を使ったOCO注文" Cells(1, 16) = TimeValue(Now) End Sub
Sub 決済発注判定() Dim i As Integer Dim 建玉NO As String Dim 発注ID As String For i = 3 To 25 If Cells(i, 12) <= -5000 Or Cells(i, 12) >= 5000 Then 建玉NO = Cells(i, 10) 発注ID = Now() If Cells(i, 5) = "買" Then Call 決済売(建玉NO, 発注ID) Else Call 決済買(建玉NO, 発注ID) End If End If Next End Sub Sub 決済売(建玉NO As String, 発注ID As String) Rs = FNEWORDER("N225mini", "201706", 2, 建玉NO, "1", 1, 0, 0, 1, 0, 1, "", "password", 発注ID, 1, "trade10", "", "") End Sub Sub 決済買(建玉NO As String, 発注ID As String) Rb = FNEWORDER("N225mini", "201706", 2, 建玉NO, "1", 3, 0, 0, 1, 0, 1, "", "Password", 発注ID, 1, "trade10", "", "") End Sub
Dim i As Integer Dim 建玉NO As String Dim 発注ID As String For i = 3 To 25
If Cells(i, 12) = "***END***" Then Exit For End If
If Cells(i, 12) <> "" And Cells(i, 12) * 1 <= -5000 Or Cells(i, 12) >= 5000 Then 建玉NO = Cells(i, 10) 発注ID = Now() If Cells(i, 5) = "買" Then Call 決済売(建玉NO, 発注ID) Else Call 決済買(建玉NO, 発注ID) End If End If Next End Sub Sub 決済売(建玉NO As String, 発注ID As String) Rs = FNEWORDER("N225mini", "201706", 2, 建玉NO, "1", 1, 0, 0, 1, 0, 1, "", "password", 発注ID, 1, "trade10", "", "") End Sub Sub 決済買(建玉NO As String, 発注ID As String) Rb = FNEWORDER("N225mini", "201706", 2, 建玉NO, "1", 3, 0, 0, 1, 0, 1, "", "password", 発注ID, 1, "trade10", "", "") End Sub
Dim i As Integer Dim 建玉NO As String Dim 発注ID As String
Sheets("決済").Select ’追加
For i = 3 To 25
If Cells(i, 12) = "***END***" Then Exit For End If
If Cells(i, 12) <> "" And Cells(i, 12) * 1 <= -1000 Or Cells(i, 12) >= 1000 Then 建玉NO = Cells(i, 10) 発注ID = Now() If Cells(i, 5) = "買" Then Call 決済売(建玉NO, 発注ID) Else Call 決済買(建玉NO, 発注ID) End If End If Next End Sub Sub 決済売(建玉NO As String, 発注ID As String) Dim Rs As String ’追加
Rs = FNEWORDER("N225mini", "201706", 2, 建玉NO, "1", 1, 0, 0, 1, 0, 1, "", "kkk7777", 発注ID, 1, "trade10", "", "") End Sub Sub 決済買(建玉NO As String, 発注ID As String) Dim Rb As String ’追加 Rb = FNEWORDER("N225mini", "201706", 2, 建玉NO, "1", 3, 0, 0, 1, 0, 1, "", "kkk7777", 発注ID, 1, "trade10", "", "") End Sub
============================================== If a>b Then '注文番号の取得は、Excelシートに"=ORDQUERY("1","注文番号",A1)"などと入れて頂き取得してください 'オーダーキャンセル ORDERCANCEL(取得した注文番号,1,1,パスワード) Else If a<=b Then NEWORDER(銘柄コード, ・・・・) End If ==============================================
的な感じで行けると思いまーす！！
2017年08月06日
大田孝
早速のご教示有り難うございます。 すいません。先物でした。又,同時に、複数の指値注文があります 1, else If a<=b then fneworder(指値単価) end lf のところですが、指値注文をキャンセルした後、新らたにa>=bの条件で指値注文を出す部分ですが,指直注文の指値単価(キャンセルした前と同じ)をどこから取得すべきかが分りません。 2、fopordqueryを使っても、注文中の注文単価は取得できますが,いったん、キャンセルされてしまいますので、注文単価は消えています。 指直注文中に注文単価を別のセルにコピーして注文単価を保持しようとしましたが,注文指値がキャンセルされた時点で注文単価が消えてしまい、コピーした注文単価も消えてしまいます。 3,この様に元コピーが消滅しても、コピーしたものが残る方法は,ありますか? 4、fopordqueryを使わない方もあれば、ご教授して下さい。
Public Sub Ordermini() Call SetParts'ｼｰﾄ名等を格納します Dim OrderSheet As Worksheet Dim Norder As String Dim TK(1 To 16) As Variant Set OrderSheet = Worksheets(WsName(1)) With OrderSheet Dim i As Integer For i = 1 To 16 TK(i) = .Cells(4, 16 + i) Next i End With Norder = FNEWORDER(TK(1), TK(2), TK(3), TK(4), TK(5), TK(6), TK(7), TK(8), TK(9), TK(10), TK(11), TK(12), TK(13), TK(14), TK(15), TK(16))’発注単価、発注条件はブランクです。 Call MsgBox(Norder) End Sub
1．寄り成り注文などの判定を・・・ If TimeValue(Now) = TimeValue("16:25") Then から If (TimeValue("16:25") <= TimeValue(Now)) And (TimeValue(Now) <= TimeValue("16:26")) Then のように幅を持たせる
=========================================== Option Explicit Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Sub CommandButton1_Click() Call PlaySound("C:\sound.wav", 1, 1) End Sub ===========================================
１．Windowsキー + R を押して『ファイル名を指定して実行』を表示する ２．『名前』のところに『cmd』と入れてエンターキーを押す ３．コマンドプロンプトという黒いWindowが表示される ４．たぶん画面に以下のように表示されていると思います ========================================= Microsoft Windows [Version 10.0.16299.64] (c) 2017 Microsoft Corporation. All rights reserved.
Sub Macro8() If ("0900" <= Format(Now, "hhnn") And Format(Now, "hhnn") < "1130") _ Or _ ("1230" <= Format(Now, "hhnn") And Format(Now, "hhnn") < "1500") Then
If Sheets("株価").Cells(1, 6) = 0 Then 'Macro7 End If End If
Call Application.OnTime(Now + TimeValue("00:01:00"), "Macro8") End Sub
もしパッチが当たらなくて、お急ぎの場合は 一番下の、 『To get the standalone package for this update, go to the Microsoft Update Catalog.』 と書いてあるところのリンクからMicrosoft Update Catalogに飛んでもらって、 対象OSのパッチをDLすることができますのでー それを当てると改善するかもしれません！！
'=================================================== Private tm As Double Sub 更新() Application.Calculate tm = [now()+timevalue("00:01:00")] Application.OnTime tm, "更新" End Sub '===================================================== Sub 更新やめ() Application.OnTime tm, "更新", , False End Sub
Sub calltest() With Worksheets("Sheet1") Cells(1, 1) = "=RANKING_M(""株価急騰(1分前)"", ""銘柄名"", 10, A2)" Cells(1, 2) = "=RANKING_M(""株価急騰(1分前)"", ""銘柄CD"", 10, B2)" For i = 2 To 11 Cells(i, "c") = "=QUOTE(b" & i & ", """", ""現在値"")" Next End With End Sub
Sub kousin() Application.CommandBars("岡三RSS2").Controls(5).Execute End Sub
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 And Target.Row = 1 Then If Target.Value = 1 Then Call Application.Run("Macro1") End If End Sub
確認したところ、Excelでのアドインの設定で、「OSON COM Addion 2」というのが「無効なアプリケーションアドイン」というところに入ってしまっています。 そこで、アドイン画面の下の方の「管理」から「COMアドイン」を選択し、「使用できるアドイン」の一覧を見ましたが、「OSON COM Addin2」のチェックが外れています。 チェックを入れてOKを押しても、再度「COMアドイン」を見ると、チェックが入っていない状態です。 何度やっても「OSON COM Addin2」にチェックが入らず、「無効なアプリケーションアドイン」のところに入ったままです。
#If Win64 Then Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #Else Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End If
大野様 ありがとうございます。しかしながら、下の4行目のコンパイルエラーが どうしても取れません。 Sub Kakikomi1() Dim i As Integer For i = 1 To 8000 Cells(i,1)="= QUOTE_M(A"&i&","""",""現値"")" Next i どうなおしても通りません。教えていただければありがたいです。
On Error GoTo ErrorHandler Application.ScreenUpdating = False
For i=1 to 8000 Cells(i, 4) = "=QUOTE_M(A" & i & ","""",""現値"")" Next i
ErrorHandler: Application.ScreenUpdating = True
2021年08月16日
RSSユーザー
大野様 ありがとうございました。早速一部分ですが実験してみました！ ところで、QUOTE_Mは、シート1のD列に、縦に約8000行書き込まれております。 したがいまして、削除するのは、Range(Cells(1,4),Cells(8000,4)).clearでOKと思いますが、再度書き込むのは、 For i=1 to 8000 Cells(I,4)=”QUOTE_M(Cells(I,1),””,”現値”)” （Cells(I,1)＝銘柄コード） Next I となるのでしょうか？（コンパイルエラーでOKとなりませんでした！） この書き込み方を教えていただければありがたいです。 更に、書き込むのに相応な時間がかかりそうですが、他に高速で書き込む方法（出来れば数秒で）はあるでしょうか？ 以上よろしくお願いいたします。
'拡張した発注待機関数 Public Sub MARGINORDER_EX(BrandCD As String, _ MarketCD As String, _ SalesType As String, _ ExecutiveCondition As String, _ OrderPrice As String, _ OrderAmmaunt As String, _ DurationType As String, _ Duration As String, _ AccountType As String, _ NoCommitConfirm As String, _ NoShowOrderWindow As String, _ Password As String, _ OrderCode As String, _ ExecutiveCondirionRev As String, _ OrderPriceRev As String, _ NoConfirm As String, _ NoShowWarning As String, _ MarginTradingType As String, _ DisplayArea As String, _ TargetArea As Range)
‘Public Declare PtrSafe Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" ( _ ‘ ByVal pszSound As String, _ ‘ ByVal hmod As Long, _ ‘ ByVal fdwSound As Long _ ‘ ) As Long ‘Public Const SND_ASYNC = &H1
大野様 さっそくThisWorkbook の中にPrivate Sub Workbook_Open()を埋め込みました。ファイルを立ち上げますと1～3秒ぐらいで4本値が削除されました。大きな壁を越えた気がします。大変ありがとうございました。ところで、現在、このファイルのシーケンシャルな動きを把握しようとして解析を進めております。理由は、全体のシーケンシャルな流れが把握出来ていないため、自信をもっていろいろ作業を進めることが出来ないためです。これまでの通常のソフトであれば、シーケンシャルに上から下へと読んでいけば、フローチャートを描くがことが出来て、すべてが把握できます。しかし、excelの場合は、2次元に平面に展開されており、時間的な流れが把握できません。大野さんにお聞きしたいのは、大野さんも私と同じフィーリングを持っておられますでしょうか？もしお持ちであれば、これに対して、どのような対処をされましたでしょうか？ご教授いただけますれば幸いです。
大野様 ところで了解しました。大変ありがとうございました。特に利益を求める関数は助かりました。 早速ですが、次の質問です。本日朝08：45ごろファイルを起動しましたところ、すぐに発注OK状態になってしまいました。おかしいなあ、ｲﾆｼｬﾙﾚﾝｼﾞを09:00～10:00にしたはずだが、、と思い、ﾏｸﾛを調べると、確かにｲﾆｼｬﾙﾚﾝｼﾞは考慮されていない様でした。そこでｲﾆｼｬﾙﾚﾝｼﾞの条件を加えるように変更しようと思います。添付資料に示しました様に And If Cells(6,3)<(NOW()-TODAY())を追加しようとしております。これで良いかどうかご教授いただけますれば幸いです。
Sub 記録() Static NowPosi As Long '現在どのポジションを持っているか 0：ノーポジション 1：売り、3：買い Dim NextTime As Variant
'ザラバの間の処理 If "08:45" <= Format(Now(), "HH:MM") And Format(Now(), "HH:MM") <= "15:08" Then '買いポジションの処理 If sheets("Sheet1").Range("S5") = "買い" And (NowPosi = 0 or NowPosi = 1) Then '売りポジションの決済 Call FNEWORDER("N225mini", ・・・・)
'買いポジションの新規 Call FNEWORDER("N225mini", ・・・・)
NowPosi = 3 End IF
'売りポジションの処理 If sheets("Sheet1").Range("T5") = "売り" And (NowPosi = 0 or NowPosi = 3) Then '買いポジションの決済 Call FNEWORDER("N225mini", ・・・・)
'売りポジションの新規 Call FNEWORDER("N225mini", ・・・・)
NowPosi = 1 End IF End If
'大引け If ("15:09" <= Format(Now, "HH:MM")) And (Format(Now, "HH:MM") <= "15:14") Then 'ここで引けなり発注 If NowPosi = 1 Then '売りポジションの決済 Call FNEWORDER("N225mini", ・・・・) NowPosi = 0 End If If NowPosi = 3 Then '買いポジションの決済 Call FNEWORDER("N225mini", ・・・・) NowPosi = 0 End If End IF
NextTime = Now + TimeValue("00:01:00") Call Application.OnTime(NextTime, "記録") Application.CommandBars("岡三RSS2").Controls.Item("更新").Execute
Sub 記録() Static NowPosi As Long '現在どのポジションを持っているか 0：ノーポジション 1：売り、3：買い Dim NextTime As Variant Dim OrderID As String
'ザラバの間の処理 If "08:45" <= Format(Now(), "HH:MM") And Format(Now(), "HH:MM") <= "15:08" _ or "16:30" <= Format(Now(), "HH:MM") And Format(Now(), "HH:MM") <= "5:28" Then
OrderID = Format(Now, "YYYYMMDDHHMMSS")
'買いポジションの処理 If Sheets("Sheet1").Range("S5") = "買い" And (NowPosi = 0 Or NowPosi = 1) Then If NowPosi = 1 Then '売りポジションの決済 Call Fneworder("N225mini", 202106, 2, "C", "", 3, 13, 0, 1, 1, 1, 1, "パスワードに変えました", OrderID, 1, "") End If
'売りポジションの処理 If Sheets("Sheet1").Range("T5") = "売り" And (NowPosi = 0 Or NowPosi = 3) Then If NowPosi = 3 Then '買いポジションの決済 Call Fneworder("N225mini", 202106, 2, "C", "", 1, 13, 0, 1, 1, 1, 1, "パスワードに変えました", OrderID, 1, "") End If
'大引け If ("15:09" <= Format(Now, "HH:MM")) And (Format(Now, "HH:MM") <= "15:14") _ or "05:24" <= Format(Now(), "HH:MM") And Format(Now(), "HH:MM") <= "5:29" Then
もし、毎回聞いてこられるのが面倒な時は、 If・・・と End Ifの行を2行消して頂けると毎回、自動で消しに行きます！！
※以下、"="が全角になっています。 ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ Private Sub Workbook_Open() If MsgBox("CANDLEの領域を削除しますか?", vbYesNo + vbQuestion) ＝ vbYes Then Sheets("Sheet1").Range("A1:F39").ClearContents End If End Sub ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ Option Explicit Private PreData(9) As String '←ここは、A1～A10の個数 -1 を入れてください。
Private Sub Worksheet_Calculate() Dim TargetRange As Range Dim Index As Integer Dim CntCell As Range
Index ＝ 0
'データ退避 For Each TargetRange In Range("A1:A10") '現在値と前回の値との比較 If PreData(Index) <> TargetRange.Value Then Set CntCell ＝ Cells(TargetRange.Cells.Row, TargetRange.Cells.Column + 1)
'加算 CntCell ＝ CntCell + 1
'現在のデータ退避 PreData(Index) ＝ TargetRange.Value End If
Index ＝ Index + 1 Next TargetRange
End Sub ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ ※掲示板でエラーになるため『＝』を全角にしてあります
him********さん 2015/1/2710:38:58 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(False, False) <> "A1" Then Exit Sub Range("B1") = Range("B1") + 1 End Sub
『Quote関数の使い方について』のご質問の方と同じ方(別の方でしたら、申し訳ありません)でしたら、 for loop でonTimeを複数スケジューリングされるという流れでされるとのことでしたので、 多分、ここで複数設定されたスケジューリングがすべて動いているのだと思います！！ for loopでのonTimeの複数スケジューリングのロジックを変更して、一つずつスケジューリングする形にすると このメッセージ自体で無くなると思います！！
このタスクをステップインで最初の行から実行してゆきますと、02行が実行された直後に、シート“条件注文”の中に付随する、Private Sub Worksheet_Calculate() というタスクにジャンプします。そしてそのタスクのENDに来て直後03行に戻ります。再度ステップインを実行しますと、再度又Private Sub Worksheet_Calculate()にジャンプします。 結局09に来るまでに7回、全く関係の無いと思われるPrivate Sub Worksheet_Calculate()に飛びます。そこで私の質問は、 1. この現象はなぜ起きるのでしょうか？ 2．このような飛ばしが必要な理由は何かあるのでしょうか？ 3．この飛ばし現象をやめさせる方法はあるでしょうか？ 以上の3個です。よろしくお願い申し上げます。
大野様 早速2つのファイルA、ファイルBの発注IDを調べましたが、N001とN002のように違っておりました。ところが、ファイルB（いくら稼げるかの実験用：本日7422円稼いだ方）の方が動作がおかしい事を発見しました。ファイルを立ち上げますと、添付のウインドウが開きます。そこでデバグをクリックしますと、マクロのPrivate Sub Worksheet_Calculate()のOrderAmendment:の中の If Cells(3, 17).Value <> 1 And Cells(4, 17).Value = 1 Then の文が黄色くなっております。不思議な事に、このエラーが出る場合と出ない場合があり、今朝は出ていなかったので、そのまま使っておりました。来週の月曜日に、エラーの無いファイルで同じ実験をして見ようと思っておりますが、このあたり何か心当たりがございましたら、教えていただけますれば幸いです。
Sub シート更新無効有効化() Dim b As Boolean Dim ws04 As Worksheet
On Error GoTo Catch
Application.ScreenUpdating = False Set ws04 = Worksheets("データ一覧") ws04.Select If K = 1 Then '無効化 b = Range("C5:H8703").Replace("QUOTE_M", "QUOTE_Z") GoTo ZZZ End If If K = 0 Then '復旧化 b = Range("C5:H8703").Replace("QUOTE_Z", "QUOTE_M") End If ZZZ:
Sub シート更新無効有効化() Dim b As Boolean Dim ws04 As Worksheet Set ws04 = Worksheets("データ一覧") ws04.Select If K = 1 Then '無効化 b = Range("C5:H8703").Replace("QUOTE_M", "QUOTE_Z") GoTo ZZZ End If If K = 0 Then '復旧化 b = Range("C5:H8703").Replace("QUOTE_Z", "QUOTE_M") End If ZZZ: End Sub
上記の事で間違いなければ、 If Sheets("四本値(移動平均)").Range("M6") = "買い" And (NowPosi = 0 Or NowPosi = 1) Then で、ゴールデンクロスの条件を判断されていますが、 四本値(移動平均)シートのM6は、"買い"などの文字ではなく、0,1でシグナルのフラグを表現されていますので、 シグナルが発生しても、発注がかからない状態となっております！("1"と"買い"の文字は異なるため)
If Sheets("四本値(移動平均)").Range("M6") = "1" And (NowPosi = 0 Or NowPosi = 1) Then
更新ボタンを押した後に、Do Until で無限ループするのですが、 その中でDoEventsを読んで、岡三RSSがセルにデータかけるようにしてあげます。 その後、RANKING_Mの関数がデータを取ってこれているか確認し 取ってこれているなら、Do Until の無限ループを抜けます。 そして後続処理のメッセージボックスが表示されるという動きです。
Private Sub CommandButton1_Click() 'A1に =RANKING_M("出来高","銘柄名","10",A2) といつ関数を入れてる
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr) Sub メイン() Range(Cells(4, 1), Cells(40, 7)) = ClearContents Cells(1, 2) = 9983 Call 更新 Call 待ち3種(4) Call 正規化 End Sub Sub 更新() Application.CommandBars("岡三RSS2").Controls.Item("更新").Execute End Sub Sub 正規化() For J = 1 To 10 Cells(J + 3, 7) = Cells(J + 3, 2) / Cells(J + 3, 3) Next J End Sub Sub 待ち3種(J) If J = 1 Then K = 0: For J = 1 To 30000000: K = K + 1: Next J: Exit Sub If J = 2 Then Application.Wait [Now()] + 5000 / 86400000: Exit Sub If J = 3 Then Sleep 5000: Exit Sub If J = 4 Then DoEvents End Sub
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr) Sub メイン() Range(Cells(4, 1), Cells(40, 7)) = ClearContents Cells(1, 2) = 9983 Call 更新 Call 待ち3種(3) Call 正規化 End Sub Sub 更新() Application.CommandBars("岡三RSS2").Controls.Item("更新").Execute End Sub Sub 正規化() For J = 1 To 10 Cells(J + 3, 7) = Cells(J + 3, 2) / Cells(J + 3, 3) Next J End Sub Sub 待ち3種(J) If J = 1 Then K = 0: For J = 1 To 30000000: K = K + 1: Next J: Exit Sub If J = 2 Then Application.Wait [Now()] + 5000 / 86400000: Exit Sub If J = 3 Then Sleep 5000: DoEvents: Exit Sub If J = 4 Then DoEvents End Sub
>If J = 1 Then K = 0: For J = 1 To 30000000: K = K + 1: Next J: Exit Sub >If J = 2 Then Application.Wait [Now()] + 5000 / 86400000: Exit Sub >If J = 3 Then Sleep 5000: Exit Sub こちらいずれも、30000000回ループしたり、5秒まったりしていますが、 DoEventsがないため、岡三RSSがセルを更新をすることができません。
>If J = 4 Then DoEvents こちらはDoEventsの記載はありますが、上の3つと違ってそもそもWait処理が入っていないため 更新ボタンを押した直後にDoEventsが動いてしまっているため 岡三RSSがサーバーからデータを取得しきる前に、 DoEventsが動いてしまい、DoEventsが実質空回りしている状態でした。
大野様 お返事ありがとうございます。 If "〇" = ThisWorkbook.Worksheets("2分").Cells(1, 26).Value Then ↓ If c Then に変更し、ＲＳＳを動かさない状態で動作させても、値が入らないですし、 ThisWorkbook.Worksheets("2分").Cells(3, 26).Value = Format(ThisWorkbook.Worksheets("2分").Cells(10, 20).Value, "hh:mm")の処理より先に進まないのですが、なぜなのでしょうか？
≪内容≫ Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" ( _ ByVal pszSound As String, _ ByVal hmod As Long, _ ByVal fdwSound As Long _ ) As Long Public Const SND_ASYNC = &H1 Sub Notify()
PlaySound "C:\WINDOWS\Media\notify.wav", 0, SND_ASYNC End Sub
是非ともご教授お願いいたします。
2023年06月10日
（追加）質問です。/ありがとうございます
2023年06月10日
大野 了
岡山さん、こんにちは！！
Excelが64bitなんですねー
Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" ( _ の部分を・・・
Public Declare PtrSafe Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" ( _
大野 了
のび太さん、こんにちは！！
なるほど！！
純粋に更新処理にかかる時間を観られてるんですねー
もしあるとしたら・・・
『再帰処理は使わずdo whileとgotoで繰り返し処理する』
こちらの処理をonTimeメソッドに変更する感じでしょうか・・・
ザラ場中は価格のチェックなどの処理を動かし続けたい為、do whileなどで繰り返し処理をされていると思います。
ですが、基本RSSはVBAが動作している時はシートへの更新処理が行えないため、いったんVBAを終了させてあげる必要があります。
このため、VBAから自分自身のVBAを呼ぶような形に変更することにより、動作が安定します！！
以前いただいた質問のリンクで大変申し訳ございませんが、こちらをご参考いただけますと幸いです。
onTimeの使い方
https://bbs.okasan-online.co.jp/ont/rss/board/?page=1&topic_id=258#comment_1385
これで直るとよいのですが・・・
2025年05月07日
のび太
大野さん
早速ありがとうございます
>CFDHISTORICALRATEDATAAUTOで取得間隔を60秒などにしておいて、
>60秒ごとに行われるCFDHISTORICALRATEDATAAUTOの実行時間がxxx秒かかるという情報の分布になりますでしょうか？
以下のような処理を行っています。
1.画面をアクティベイトした後で、そこに表示されたヘッダーより下のデータをいったん全て空白にする
2.空白にしたセルに新たなデータが表示されているかどうかをチェックする*（空白である場合は、2秒待機して繰り返し合計50回まで*を行なう。リソース不足になることを回避するため、再帰処理は使わずdo whileとgotoで繰り返し処理する。）
処理2においては、2*5秒以上かかる場合は、単に待機するだけではなく、RSSアドインの更新をかけるようにしています。
（以前、大野さんに教えていただいた方法が役に合っています。改めまして、お礼を申し上げます。）
すると、2*1秒で収まる場合もありますが、2*5秒以上かかることも結構あり、その途中の秒数（2*2秒から2*2秒）で収まることは少ないので、結構二極分解します。
ということは、仕様上のなんらかのネットワークボトルネックで更新が必要なシステム状態になっているのかもしれません。
また、私はCPUはi3からi9まで、メモリは16GBから128GMまでいろいろなPCを利用していますが、低機能のPCのほうが止まってしまうことが多いようです。
もしかしたらCPUやメモリがボトルネックなのかもしれません。
といっても、単純な処理すし、CPUi3メモリ16GBでもタスクマネージャで見ると余力はたっぷりあるので、CPUやメモリがボトルネックとはちょっと考えられないです。
もしかしたら、仮想メモリが無駄に多くなっていてボトルネックになっているかもしれないので、今後仮想メモリをゼロにしたらどうなるかも調べてみます。
2025年05月06日
大野 了
のび太さん、こんにちは！！
では、自分もこちらにまとめてー
情報共有ありがとうございます！！
ありがたい限りです！
こちらは、CFDHISTORICALRATEDATAAUTOで取得間隔を60秒などにしておいて、
60秒ごとに行われるCFDHISTORICALRATEDATAAUTOの実行時間がxxx秒かかるという情報の分布になりますでしょうか？
※実行が2秒程度で終わる場合や、10秒以上かかってしまうなど両極端
※ホントは最頻値や平均値で正規分布してほしい
『単位時間あたりにアクセスが集中しました。』を再現させたいところですね。
もうちょっと再現できないか、チャレンジしてみます！
2025年05月05日