返回列表 上一主題 發帖

[發問] 誰能幫這幾乎重複動作的VBA瘦身 謝謝

回復 40# azrael19

看起來很妥當了
我看您要求改的部分 是4捨5入 看起來那些格內值並沒有改變 但為何比對結果就正確了???
另外 為何我只要開啟您的檔案 我未做任何動作便關上 它就會提示資料已更改 問我要不要存檔???
為何您的檔案超級小 且執行起來也很快(跟我寫的比) ?
您真的是高手中的高手

謝謝您了

TOP

回復  azrael19

看起來很妥當了
我看您要求改的部分 是4捨5入 看起來那些格內值並沒有改變 但為何比對 ...
lcctno 發表於 2015-8-29 11:58


1.浮點數誤差,請參考 https://support.microsoft.com/zh-tw/kb/214118
  所以也可以將 A4公式改成: =TRUNC(A3+Data!$L$4,2),這是您原始檔所使用的方式。
2.其實您所提供的-test% -.zip就會了,這個我也不太知道...
  (可能打開檔案時的運算超過一定數量範圍或是使用到特定功能就會這樣,例如您的原始檔我只要將WebQuery移除就不會問了...)
3.因為使用的儲存格少自然就小,運算少自然等待時間就短。

我不是高手,如果有常在論壇爬文,同時將版主們的回覆親自動手做過一遍就可以很快學到這些技巧,只是用看的大概很快就忘光了...
還有你應該要感謝是前面回覆您問題的前輩,如果一開始就先將公式簡化再來問如何用VBA瘦身,那個運算速度會比我給你的快多了

TOP

回復 42# azrael19
感謝您的用心 我從沒正式的上過PC相關的課 只為了安心的投資股票
所以才土法煉鋼 用最簡單基本的函數寫了數個"大巨蛋"
那些我寫的"大巨蛋" 居然有單一檔就超過700mb 執行起來 還真慢 所以也是為了將檔案瘦身才來麻辣家族求救
來到麻辣家族還算真的很受益 謝謝您大力的幫助我 真心的感謝您
您說用VBA會更快? 您完成的已經很快了 我還真想看看vba能快到什麼程度
您說如果我再用您幫我完成的檔案再發一次帖 會不會被人當成灌水發帖?

TOP

回復  azrael19
感謝您的用心 我從沒正式的上過PC相關的課 只為了安心的投資股票
所以才土法煉鋼 用最簡 ...
lcctno 發表於 2015-8-29 14:52


還是不要好了,先說我沒有惡意您看了千萬別誤會
這裡是讓大家學習釣魚的技巧及分享學習經驗,當大家發現你只是想請人幫你釣魚,很快你的問題就得不到任何回覆...
基本上等你有能力看懂前面回覆您問題前輩的程式碼,再提出問題會比較適當。
還有與主題無關的回覆就算灌水,我現在的回覆就算了,所以您千萬別再回覆我

TOP

回復 43# lcctno

data!J2 可以直接帶函數比較簡單一些
=FORECAST(I2,OFFSET(結果!D1,MATCH(I2,結果!A:A,1),,-2),OFFSET(結果!A1,MATCH(I2,結果!A:A,1),,-2))


FORECAST(x,known_y's,known_x's)
X    是您要預測一個數值的資料點。
Known_y's    是因變數陣列或資料範圍。
Known_x's    是自變數陣列或資料範圍。



原 data!J2 公式
=IF(ISERROR(LOOKUP(I2,OFFSET(結果!$A$3,,,結果!$E$2,),ROW(OFFSET(結果!$A$3,,,結果!$E$2,)))),"--",IF(LOOKUP(I2,OFFSET(結果!$A$3,,,結果!$E$2,),ROW(OFFSET(結果!$A$3,,,結果!$E$2,)))>=結果!$E$2+2,1,VLOOKUP(I2,IF({1,0},OFFSET(結果!$A$3,,,結果!$E$2,),OFFSET(結果!$D$3,,,結果!$E$2,)),2)+(I2-LOOKUP(I2,OFFSET(結果!$A$3,,,結果!$E$2,)))*LINEST(OFFSET(INDIRECT("結果!D"&LOOKUP(I2,OFFSET(結果!$A$3,,,結果!$E$2,),ROW(OFFSET(結果!$A$3,,,結果!$E$2,))),1),,,2,),OFFSET(INDIRECT("結果!A"&LOOKUP(I2,OFFSET(結果!$A$3,,,結果!$E$2,),ROW(OFFSET(結果!$A$3,,,結果!$E$2,))),1),,,2,))))
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復 43# lcctno

SUMPRODUCT函數很慢,需減少使用
A3:A2562 公式範圍太大使用計算變得很慢,實際才使用到A743

建議改為

結果!
A3 =IF(Data!N$2+Data!O$2*(ROW()-4) > Data!K$2, "", Data!N$2+Data!O$2*(ROW()-3))
B3 =IF(A3="",0,SUMPRODUCT((A3<=資料列_最高價)*(A3>=資料列_最低價)))
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

為何我只要開啟您的檔案 我未做任何動作便關上 它就會提示資料已更改 問我要不要存檔???
OFFSET,INDIRECT,NOW,TODAY....等等函數, 都會造成這個提示!

SUMPRODUCT計算上萬筆資料, 若PC等級不高, 大部份光開啟檔案就要等很久,
又, 若是為[常駐]公式, 統計來源表任一儲存格每一次變動, 即會跑出〔自動重算〕(俗稱:卡檔), 非常不方便,

使用VBA可以改善以上情況, 缺點是:數據變動後, 必須再執行程式, 無法隨時顯示動態結果!

TOP

回復 47# 准提部林
希望您有辦法幫我 若可以的話 附上說明 我也很想學

附上貴人們的指導後 完成的檔案 希望能多提供改善的地方 謝謝您


大盤2011-12-19起.rar (135.89 KB)

TOP

用上次VBA修改如下(只列出結果表B欄次數,其他不處理):
TEST02.rar (134.34 KB)

Sub 分析()
Dim Arr, Brr, Cunt&, Crr%(), R&, X&, Y&, TM, j%, k&, SU%
TM = Timer
R = [data!C65536].End(xlUp).Row
Arr = [Data!C1:D1].Resize(R)

X = Val([Data!I6]): If X < 2 Then X = 2
Y = Val([Data!J6]): If Y > R Then Y = R
If Y <= X Then Exit Sub

Cunt = 2560
ReDim Crr(1 To Cunt, 0)
Brr = [結果!A3].Resize(Cunt)
For j = 1 To Cunt
  For k = X To Y
    'If Brr(j, 1) >= Arr(k, 2) And Brr(j, 1) <= Arr(k, 1) Then SU = SU + 1 '判斷兩次,速度較慢
    If Brr(j, 1) >= Arr(k, 2) Then If Brr(j, 1) <= Arr(k, 1) Then SU = SU + 1 '第一條件成立再判斷第二條件,較快
  Next k
  Crr(j, 0) = SU: SU = 0
Next j
[結果!B3].Resize(Cunt).Value = Crr
Application.Goto [結果!B3]
MsgBox Timer - TM
End Sub

TOP

本帖最後由 lcctno 於 2015-8-29 21:47 編輯

回復 49# 准提部林

[attach]21867[/attach]

可能是判讀的程式碼不同所至 請看附件內紫色的部分 由於這執行檔是能要讓股票及指數來使用 還請費心了

謝謝您的辛勞


如果基準值(比較點) >= 列之最低價 同時 <= 列之最高價 就給 1   
也就是說只要基準值(比較點)有在區間內就給1  
=IF(AND(基準值>=Data!D3,基準值<=Data!C3),1,"")

TEST03.rar (170.23 KB)

TOP

        靜思自在 : 自己害自己,莫過於亂發脾氣。
返回列表 上一主題