API逐筆運算負擔大，可否精簡 - Excel程式區

帖子: 26
主題: 4
精華: 0
積分: 30
點名: 0
作業系統: Win10
軟體版本: Office2019
閱讀權限: 10
性別: 男
註冊時間: 2018-10-12
最後登錄: 2022-7-25

21^# 跳轉到 »

發表於 2018-10-29 18:43 | 只看該作者

回復 19# GBKEE
不好意思 G大又有問題想請教您了！
前幾天試著用檔案內的"sub執行"，採用"sub報價運算"搭配其他程序，在盤後運算非常快速沒問題，
盤中運算在開盤時數據較少，初期都可以正常運作，但後期就會變得一直運算，沒有顯示任何運算結果，直到excel崩潰或手動停止；
因為在盤後運行(數據不會更新)的情況下都可以非常順利運作，所以我試著改變報價及運算迴圈方式("sub執行"的方式)，讓每一個sub都跑完再進行重新整理來更新報價數據，卻也一樣一直運算而沒有結果(運作中沒有任何結果，但手動按下停止後運算結果就全部顯現...)，
設想是因為迴圈綁架了CPU之類的，觀察了CPU/記憶體使用率卻也不到50%，

為了試著將程式負擔再降低，想起之前您在本串14樓的時候有幫我寫過一個針對多空加總運算的sub (放在模組3的K心態)，當時沒有完整的多空判斷，現在想加入判斷式來歸類在多空上(請參考"sub報價運算")，
可能思考上一直碰壁，對Offset的方式一直無法整個理解，試著改來改去都失敗，
所以想詢問
1.此段程序該如何加上新增的判斷式呢
2.就您的經驗與在盤中執行遇到的問題，改成執行完後再進行報價更新，是否有幫助呢

因檔案超過附件容量限制，所以上傳至雲端Google雲端

謝謝！

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

22^#

發表於 2018-10-30 06:57 | 只看該作者

回復 21# dreamsway
修改看看

ElseIf .Cells.Offset(1) = "" Then '****程式運行速度很快會跑完報價數據 **
wTime = Time '**請在程式碼開端 Dim wTime As Date
Do
If wTime > Time - #12:00:30 AM# Then '30秒重新整理一次
Application.StatusBar = "重新整理...."
重新整理
wTime = Time
End If
DoEvents
Loop While .Cells.Offset(1) = "" '**當 .Cells.Offset(1) = "" 一直執行下去
Application.StatusBar = False
End If

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

dreamsway

小學生 Rank: 1

帖子: 26
主題: 4
精華: 0
積分: 30
點名: 0
作業系統: Win10
軟體版本: Office2019
閱讀權限: 10
性別: 男
註冊時間: 2018-10-12
最後登錄: 2022-7-25

23^#

發表於 2018-10-30 14:47 | 只看該作者

[版主管理留言]

GBKEE(2018/10/30 18:40): 附上檔案看一下

回復 22# GBKEE
G大午安，因為我還在試著學習更改新的多空判斷條件套用在這種相對路徑的寫法，所以這個時間延遲的部分可能需要明後天才能測試，
我想在原本的條件

Do
With Sheets("報價數據").Range("b2").Offset(i)
If 成交價 < .Cells(1, 2) Then 多放 = 多放 + .Cells(1, 3) Else 多空 = 多空 + .Cells(1, 3)
成交價 = .Cells(1, 2)

複製代碼

更改為

Do
With Sheets("報價數據").Range("b1").Offset(i)
If 成交價 < .Cells(1, 2) Then 方向 = "↑"
If 成交價 > .Cells(1, 2) Then 方向 = "↓"
If 成交價 <= .Cells(1, 2) And 方向 = "↑" Then 多總 = 多總 + .Cells(2, 3)
If 成交價 >= .Cells(1, 2) And 方向 = "↓" Then 空總 = 空總 + .Cells(2, 3)
成交價 = .Cells(1, 2)

複製代碼

想詢問為什麼這一行一直顯示錯誤

成交價 = .Cells(1, 2)

複製代碼

[/code]
查了一下微軟說明顯示：嘗試指派值給 With...End With 陳述式中使用的結構成員，將會收到錯誤，但G大您提供的的代碼卻又正常:'( :'(

TOP

dreamsway

小學生 Rank: 1

帖子: 26
主題: 4
精華: 0
積分: 30
點名: 0
作業系統: Win10
軟體版本: Office2019
閱讀權限: 10
性別: 男
註冊時間: 2018-10-12
最後登錄: 2022-7-25

24^#

發表於 2018-10-30 19:00 | 只看該作者

回復 22# GBKEE

雲端檔案
再麻煩G大解惑了，謝謝！

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

25^#

發表於 2018-10-30 19:42 | 只看該作者

回復 24# dreamsway
Range.Offset 屬性會傳回 Range 物件，代表從指定之範圍位移的範圍。
可再詳看說明

i = 0 '**b1 是標頭為文字 i=0 --> .Offset(i) 還是b1, 成交價 As Double ,所以有形態的錯誤
Do
With Sheets("報價數據").Range("b1").Offset(i)

複製代碼

可修改

i = 1
Do
With Sheets("報價數據").Range("b1").Offset(i)
或是
i = 0
Do
With Sheets("報價數據").Range("b2").Offset(i)

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

dreamsway

小學生 Rank: 1

帖子: 26
主題: 4
精華: 0
積分: 30
點名: 0
作業系統: Win10
軟體版本: Office2019
閱讀權限: 10
性別: 男
註冊時間: 2018-10-12
最後登錄: 2022-7-25

26^#

發表於 2018-10-31 20:42 | 只看該作者

回復 22# GBKEE

G大您好！25樓的部分修改後已測試可以正確運算了，但21樓的問題仍在，
想詢問代碼的意思是每過30秒會執行迴圈嗎!? 因為單執行K心態sub，只會執行一次將現有的報價跑完，跳出MsgBox工作完成後就沒有任何動作，期間的重新整理也沒反應(執行前的報價跟執行結束的報價沒變，讓巨集運行整個停止也是沒變)
我試著用以下代碼的執行sub，讓他重新整理來獲取報價再執行K心態sub，則會讓K心態跑一次後一直呈現運轉狀態，但這期間報價不會更新、DDE數據也同步停止；直到我手動讓巨集停止運行後才會把這段期間的報價一次顯現出來

Sub 執行()
Call 共用參照
Sht1.Range("J1") = "運行中.."
uMode = 1
Do
Call 重新整理
Call K心態
Loop Until uMode = 0
If uMode = 0 Then
Sht1.Range("J1") = ">停止<"
End If
End Sub

複製代碼

附檔

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

27^#

發表於 2018-11-1 15:51 | 只看該作者

回復 26# dreamsway

想詢問代碼的意思是每過30秒會執行迴圈嗎!? 因為單執行K心態sub，只會執行一次將現有的報價跑完，跳出後就沒有任何動作

是數據已跑到收盤時間了嗎?

請看一下註解的說明

Option Explicit
Const 間隔 = #12:05:00 AM# '這裡修改分鐘間隔
Const 開盤 = #8:45:00 AM#
Sub K心態()
Dim i As Long, Ti As Integer, 成交價 As Double, 多總 As Long, 空總 As Long, 方向 As String
Dim xTime As Date, wTime As Date
xTime = 開盤 + 間隔
i = 1: Ti = 0: 多總 = 0: 空總 = 0
成交價 = Sheets("多空藍圖").Range("M4") '欄位暫代
Do
With Sheets("報價數據").Range("b1").Offset(i)
'**間隔為 #12:05:00 AM# 這"↑","↓"數據準確嗎?***
If 成交價 < .Cells(1, 2) Then 方向 = "↑"
If 成交價 > .Cells(1, 2) Then 方向 = "↓"
If 成交價 <= .Cells(1, 2) And 方向 = "↑" Then 多總 = 多總 + .Cells(2, 3)
If 成交價 >= .Cells(1, 2) And 方向 = "↓" Then 空總 = 空總 + .Cells(2, 3)
成交價 = .Cells(1, 2)
If .Value > xTime + 間隔 Then
With Sheets("測試").Range("A2").Offset(Ti)
.Resize(, 3) = Array(xTime, 多總, 空總)
.NumberFormatLocal = "hh:mm;@"
End With
xTime = xTime + 間隔: Ti = Ti + 1
Else
If .Cells.Offset(1) = "" And Format(TimeValue(.Cells.Text), "HH:MM") = "13:45" Then
'***程式運行速度很快會跑完報價數據,時間已到"13:45"收盤不再有數據了 **
xTime = xTime + 間隔
With Sheets("測試").Range("A2").Offset(Ti)
.Resize(, 3) = Array(xTime, 多總, 空總)
.NumberFormatLocal = "hh:mm;@"
End With
Exit Do
ElseIf .Cells.Offset(1) = "" Then
'****程式運行速度很快會跑完報價數據,但是數據還會有因時間還未到"13:45"收盤時 ... **
'**程式到這理執行重新整理的程式有更新到 _20180724_Match 對嗎? **
'**********************************************
Do
If wTime > Time - #12:00:30 AM# Then '30秒重新整理一次
'**試稍待一下等候新的數據
Application.StatusBar = "重新整理...."
重新整理 '** 更新 _20180724_Match 如有新的資料進來
'*************************.Cells.Offset(1)就 <>"" ***
wTime = Time
End If
DoEvents
Loop While .Cells.Offset(1) = "" '**還是沒有新的數據就一直等候...
'*** 如有新的資料進來離開迴圈繼續下去到 i = i + 1 的地方再 Loop 下去 ***
Application.StatusBar = False
End If
End If
End With
DoEvents
i = i + 1
Loop
MsgBox "工作完成"
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

dreamsway

小學生 Rank: 1

帖子: 26
主題: 4
精華: 0
積分: 30
點名: 0
作業系統: Win10
軟體版本: Office2019
閱讀權限: 10
性別: 男
註冊時間: 2018-10-12
最後登錄: 2022-7-25

28^#

發表於 2018-11-2 22:05 | 只看該作者

回復 27# GBKEE
G大您好！今天在盤中測試發現狀況照舊，試著把報價手動作了調整後用一筆一筆F8監測，發現就算符合條件的情況下

If .Cells.Offset(1) = "" Then

複製代碼

但每次都會把wTime = Time以及重整的語法跳過去，所以之前都不會進行後面的重新整理
後來我把wTime = Time換了位置，變成以下代碼

Do
wTime = Time '語法位置調整
If wTime > Time - #12:00:30 AM# Then '30秒重新整理一次
'**試稍待一下等候新的數據
Application.StatusBar = "重新整理...."
重新整理 '** 更新 _20180724_Match 如有新的資料進來
'*************************.Cells.Offset(1)就 <>"" ***
'wTime = Time 原本位置
End If
DoEvents

複製代碼

改完之後雖然會重新整理了....但每次回圈都重整，不會有30秒才重整的情況

if wTime > Time - #12:00:30 AM# Then '30秒重新整理一次

複製代碼

接著就是持續不間斷重新整理到EXCEL崩潰的情況發生
我在想是不是可以從重新整理那邊做調整

Sub 重新整理()
ActiveWorkbook.RefreshAll
End Sub

複製代碼

請問G大是否能改成像是5秒內再度執行會exit sub的語法呢
謝謝！

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

29^#

發表於 2018-11-3 14:40 | 只看該作者

回復 28# dreamsway

程式碼有點錯誤請更正看看

ElseIf .Cells.Offset(1) = "" Then
'****程式運行速度很快會跑完報價數據,但是數據還會有因時間還未到"13:45"收盤時 ... **
'**程式到這理執行重新整理的程式有更新到 _20180724_Match 對嗎? **
'**********************************************
wtime = Time '** 抱歉這裡遺漏了*****
Do
'*** 還有應是 If wtime < Time - #12:00:30 AM# Then 才對
If wtime < Time - #12:00:30 AM# Then '30秒重新整理一次
'**試稍待一下等候新的數據
Application.StatusBar = "重新整理...."
重新整理 '** 更新 _20180724_Match 如有新的資料進來
'*************************.Cells.Offset(1)就 <>"" ***
wtime = Time
End If
DoEvents
Loop While .Cells.Offset(1) = "" '**還是沒有新的數據就一直等候...
'*** 如有新的資料進來離開迴圈繼續下去到 i = i + 1 的地方再 Loop 下去 ***
Application.StatusBar = False
End If

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

dreamsway

小學生 Rank: 1

帖子: 26
主題: 4
精華: 0
積分: 30
點名: 0
作業系統: Win10
軟體版本: Office2019
閱讀權限: 10
性別: 男
註冊時間: 2018-10-12
最後登錄: 2022-7-25

30^#

發表於 2018-11-6 11:48 | 只看該作者

本帖最後由 dreamsway 於 2018-11-6 11:49 編輯

回復 29# GBKEE
G大早安測了幾天，若用手動F8測試已可以執行到重新整理及30秒的部分沒問題，
不過盤中在重整的地方一直卡關，手動重整是沒問題可以完整運行(約1秒就可以更新完)，但如果是透過巨集則會卡關，呈現一直轉圈但沒報價出現的情況，直到手動強制中斷巨集才會出現，
不知道是不是電腦太爛...不過CPU跟記憶體使用率都還頗低(最高只到35%左右)，這幾天找時間跟朋友借個好一點的電腦跑跑看，
另外在運算結果(多空數據)的呈現上，報價時間的最新兩個紀錄點不會記錄，例如報價已更新到16分，但15分跟20分的數據並不會顯現，
因為不會做GIF檔..所以用錄製的方式表現重整的狀況影片

TOP

[發問] API逐筆運算負擔大，可否精簡

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]