Board logo

標題: 這種依時間運算的巨集要如何寫?? [打印本頁]
作者: 藍天麗池    時間: 2014-11-15 17:03     標題: 這種依時間運算的巨集要如何寫??

請問版上大大，如果我要寫一個巨集功能如下，要如何寫
A1=5
B1=3
C1=4

A2=7
B2=6
C2=9

如果我要在8:46分執行運算E1=SUM(A1:C1)，8:47分執行E2=SUM(A2:C2)，依此類推一直執行到13:45分，且執行完後直接寫入值，而不是公式，請問版上大大這個巨集要如何寫呢??

P.S 我之前有試過直接將公式寫在儲存格，但發現資料量大的話會拖慢執行數度，所以想跟版上大大請教一下用巨集要如何寫
上面的示範例，我實際執行的資料量比較大
作者: PKKO    時間: 2014-11-16 01:33

本帖最後由 PKKO 於 2014-11-16 01:36 編輯

回復 1# 藍天麗池

試試看
  1. Public i As interger
  2. Sub test1()
  3.     i = 1
  4.     Application.OnTime TimeValue("08:46:00"), "test2" '特定時間呼叫程式
  5. End Sub
  6. Sub test2()
  7.     Range("e" & i) = Application.WorksheetFunction.Sum(Range("A" & i & ":" & "C" & i + 2)) '輸入值
  8.    
  9.     If Hour(Time) = 13 Then '判斷小時
  10.         If Minute(Time) = 45 Then '判斷分
  11.             MsgBox "結束" '相同時分則不再進行
  12.         Else
  13.             Application.OnTime Now + TimeValue("00:01:00"), "test2" '一分鐘後運行
  14.         End If
  15.     Else
  16.         Application.OnTime Now + TimeValue("00:01:00"), "test2" '一分鐘後運行
  17.     End If
  18.     i = i + 1
  19. End Sub
複製代碼
作者: 藍天麗池    時間: 2014-11-16 10:23

本帖最後由 藍天麗池 於 2014-11-16 10:29 編輯

[attach]19553[/attach]回復 2# PKKO

請問大大，會出現使用者型態尚未定義是什麼意思
另外，如果我要把Range("e" & i) = Application.WorksheetFunction.Sum(Range("A" & i & ":" & "C" & i + 2))裡面的SUM函數改成=IF(ISERROR(MATCH(U2,P:P,0)),"",MATCH(U2,P:P,0))，那請問一下巨集要怎麼改??

是改成Range("e" & i) = Application.WorksheetFunction.IF(ISERROR(MATCH(Range("U" & i +1& "," & "P" &":" & "P" & "," & "0"),"",MATCH(Range("U" & i +1& "," & "P" &":" & "P" & "," & "0"))改成這樣對嗎??

請問大大Range("A" & i & ":" & "C" & i + 2)裡面的範圍部分，除了用&的的方式有沒有其他寫法，因為公式如果很多的話會&不完

抱歉大大問題有點多，不過還是謝謝你的回覆

大大我有附上我的檔案，其實我要修改的是T、W、X欄的部分，因為直接寫在儲存格上面會造成運算變慢，所以我才會想用巨集的方式試試看，如果大大能直接幫我修改就真的是感激不盡，如果不能，還帆請大大幫我解答一下上面的問題，感謝
作者: GBKEE    時間: 2014-11-16 15:31

本帖最後由 GBKEE 於 2014-11-16 15:43 編輯

回復 3# 藍天麗池

試試看
  1. Option Explicit
  2. Dim i As Integer '(短整數)資料型態
  3. 'Public i As interger => 出現使用者型態尚未定義, 正確: Integer
  4. Sub Ex()
  5.     Dim xTime As Date
  6.     If Time >= #8:46:00 AM# And Time <= #1:45:00 PM# Then
  7.         With Sheets("RTD").Cells(i + 2, "T")
  8.                     'T欄公式=IF(ISERROR(MATCH(U2,P:P,0)),"",MATCH(U2,P:P,0))
  9.             .Range("A1") = "=IF(ISERROR(MATCH(RC[1],P:P,0)),"""",MATCH(RC[1],P:P,0))"
  10.                     'U欄
  11.             .Range("B1") = IIf(Minute(Time) Mod 2 = 0, Application.Sum(Range("A1:C1")), Application.Sum(Range("A2:C2")))
  12.                     'V欄
  13.             .Range("C1") = Time
  14.                     'W欄公式=IF(ISERROR(INDIRECT("O"&T2)),"",INDIRECT("O"&T2))
  15.             .Range("D1") = "=IF(ISERROR(INDIRECT(""O""&RC[-3])),"""",INDIRECT(""O""&RC[-3]))"
  16.                     'X欄公式=IF(W2="","",IF(W2>54,-1,IF(W2<6,1,"")))
  17.             .Range("E1") = "=IF(RC[-1]="""","""",IF(RC[-1]>54,-1,IF(RC[-1]<6,1,"""")))"
  18.                     'Y欄公式=IF(ISERROR(INDIRECT("R"&T2)),Y1,INDIRECT("R"&T2))
  19.             .Range("F1") = "=IF(ISERROR(INDIRECT(""R""&RC[-5])),R[-1]C,INDIRECT(""R""&RC[-5]))"
  20.             .Resize(, 6) = .Resize(, 6).Value  '將公式回數值
  21.         End With
  22.         i = i + 1
  23.         xTime = Time + #12:01:00 AM#
  24.         If xTime <= #1:45:00 PM# Then Application.OnTime xTime, "EX"
  25.     ElseIf Time < #8:46:00 AM# Then
  26.         Application.OnTime #8:46:00 AM#, "EX"
  27.     Else
  28.         MsgBox "時間已過"
  29.     End If
  30. End Sub
複製代碼
作者: 藍天麗池    時間: 2014-11-16 18:04

回復 4# GBKEE

G大謝謝你的回覆，真的很感謝你，等等來試試看，謝謝
作者: 藍天麗池    時間: 2014-11-16 18:50

回復 4# GBKEE


    G大測試過後只有U欄和V欄有數字其他都顯示空白
作者: 藍天麗池    時間: 2014-11-16 20:14

回復 4# GBKEE


    G大，剛剛上述的部分我已經修改完成了，目前執行上是OK的，不過跟G大說一聲抱歉，因為我跑完後發現這不是我要的結果，想在請教一下G大，如果我要把之前的那個程式改成函數還是在儲存格上面，但當每分鐘執行完後接值寫在儲存格內(主要是要看每秒鐘的變化，但是程式執行後變成每分鐘到的時候才看的到數值)，而是不公式，請問一下G大這樣要怎麼改??
作者: 藍天麗池    時間: 2014-11-16 20:47

回復 4# GBKEE

G大剛剛的回覆有點亂，以下才是真實版本(抱歉邏輯有點亂掉才會這樣)

    G大，剛剛上述的部分我已經修改完成了，目前執行上是OK的，不過跟G大說一聲抱歉，因為我跑完後發現這不是我要的結果

想在請教一下G大，如果我要把之前的那個程式改成函數出現在後一分鐘的儲存格，等到時間到在寫成值(主要是要看每秒鐘的變化，但是之前的程式執行後變成每分鐘到的時候才看的到數值)，例如8:45分的時候將公式寫在8:46分相對應的儲存格，然後8:46分到的時候再將公式寫成值，請問一下G大這樣要怎麼改??
作者: GBKEE    時間: 2014-11-17 14:33

回復 8# 藍天麗池

是這樣嗎?
  1. With Sheets("RTD").Cells(i + 2, "T").Resize(, 7)
  2.             .Offset(-1).Value = .Offset(-1).Value '上一列:將公式回數值
  3.             
  4.                     'T欄公式=IF(ISERROR(MATCH(U2,P:P,0)),"",MATCH(U2,P:P,0))
  5.             .Range("A1") = "=IF(ISERROR(MATCH(RC[1],P:P,0)),"""",MATCH(RC[1],P:P,0))"
  6.                     'U欄
  7.             .Range("B1") = IIf(Minute(Time) Mod 2 = 0, Application.Sum(Range("A1:C1")), Application.Sum(Range("A2:C2")))
  8.                     'V欄
  9.             .Range("C1") = Time
  10.                     'W欄公式=IF(ISERROR(INDIRECT("O"&T2)),"",INDIRECT("O"&T2))
  11.             .Range("D1") = "=IF(ISERROR(INDIRECT(""O""&RC[-3])),"""",INDIRECT(""O""&RC[-3]))"
  12.                     'X欄公式=IF(W2="","",IF(W2>54,-1,IF(W2<6,1,"")))
  13.             .Range("E1") = "=IF(RC[-1]="""","""",IF(RC[-1]>54,-1,IF(RC[-1]<6,1,"""")))"
  14.                     'Y欄公式=IF(ISERROR(INDIRECT("R"&T2)),Y1,INDIRECT("R"&T2))
  15.             .Range("F1") = "=IF(ISERROR(INDIRECT(""R""&RC[-5])),R[-1]C,INDIRECT(""R""&RC[-5]))"
  16.                     'Z欄公式=IF(ISERROR(Y2-Y1),"",Y2-Y1)
  17.             .Range("G1") = "=IF(ISERROR(RC[-1]-R[-1]C[-1]),"""",RC[-1]-R[-1]C[-1])"
  18.            
  19.         End With
  20.         
複製代碼
作者: 藍天麗池    時間: 2014-11-17 20:09

回復 9# GBKEE

G大真的很謝謝你，這樣OK了
作者: 藍天麗池    時間: 2014-12-6 20:10

本帖最後由 藍天麗池 於 2014-12-6 20:19 編輯

回復 9# GBKEE


    G大可以再幫我一次嗎??
[attach]19719[/attach]

因為程式關係，所以這次要做點小修改，在麻煩G大一下

上次的程式是寫成往下執行，過一分鐘後再將前一個寫成值，這次我要將程式改成往右邊執行(就是這一分鐘執行T欄，下一分鐘執行U欄，且把T欄的公式寫為值，以此類推)，請問一下G大，如果這樣的話程式要怎麼改呢??

簡單的說就是執行的內容不變，只是行列對調

感謝您
作者: GBKEE    時間: 2014-12-7 06:25

回復 11# 藍天麗池
  1. Option Explicit
  2. Dim NextTime As Date
  3. Sub RecordPrice()
  4.     Dim i As Integer
  5.     i = Cells(2, Columns.Count).End(xlToLeft).Column
  6.     'i: 傳回工作表最右邊的儲存格, 向左到最後有資料的儲存格的欄號
  7.     'Cells(列號, 欄號).END(向左到最後有資料的儲存格)
  8.     'Columns.Count(工作表欄物件的總計)
  9.     With Range("t2")
  10.         If .Value = "" Then
  11.             .Cells = "公式A"          '你的公式
  12.             .Cells(2) = "公式B"       '下一列的公式
  13.         ElseIf i >= .Column Then      '
  14.              '這裡沒有.Cells 為這工作表以A1為基點的Cells
  15.             Cells(2, i) = Cells(2, i).Value
  16.             Cells(3, i) = Cells(3, i).Value
  17.             Cells(2, i + 1) = "公式A" '下一欄給公式
  18.             Cells(3, i + 1) = "公式B"
  19.         End If
  20.     End With
  21. End Sub
複製代碼
作者: 藍天麗池    時間: 2014-12-7 09:16

本帖最後由 藍天麗池 於 2014-12-7 09:19 編輯

回復 12# GBKEE

跟G大請教兩個問題：

1.我之前的想法是只要行列互換，所以如果只將With Sheets("RTD").Cells(i + 2, "T").Resize(, 7)改成With Sheets("RTD").Cells("T" , i + 2).Resize(5 ,) 這樣是可以的嗎??
2. .Offset(-1).Value = .Offset(-1).Value '上一列:將公式回數值            另外這行我就不會改了
3.如果1.的想法是正確的那之前下面的公式要怎麼改??

4.i = Cells(2, Columns.Count).End(xlToLeft).Column
    'i: 傳回工作表最右邊的儲存格, 向左到最後有資料的儲存格的欄號
    'Cells(列號, 欄號).END(向左到最後有資料的儲存格)
    'Columns.Count(工作表欄物件的總計)
以上是這次的新公式，請問G大這個新公式可以設定從哪一列開始嗎??因為我O欄之前有其他的東西，這樣會影響到嗎??

5. If .Value = "" Then
            .Cells = "公式A"          '你的公式
            .Cells(2) = "公式B"       '下一列的公式
以上是這次的新公式，G大是舉兩個為例，如果我要增加公式改成以下這樣是否正確
If .Value = "" Then
            .Cells = "公式A"          '你的公式
            .Cells(2) = "公式B"       '下一列的公式
           .Cells(3) = "公式C"       '下一列的公式
           .Cells(4) = "公式D"       '下一列的公式
                                       .
                                       .
                                       .
                                以此類推
6.ElseIf i >= .Column Then      '
             '這裡沒有.Cells 為這工作表以A1為基點的Cells
            Cells(2, i) = Cells(2, i).Value
            Cells(3, i) = Cells(3, i).Value
            Cells(2, i + 1) = "公式A" '下一欄給公式
            Cells(3, i + 1) = "公式B"
如果5.修改程式增加公式數量，那6.的部分要修改嗎??

抱歉G大問題有點多還請G大不吝指教，感謝
作者: GBKEE    時間: 2014-12-7 10:13

回復 13# 藍天麗池
查看VBA Offset 屬性 的說明
  1. .Offset( ,-1).Value = .Offset( ,-1).Value '左一欄:將公式回數值            
複製代碼
i: 傳回工作表最右邊的儲存格, 向左到最後有資料的儲存格的欄號
O欄在T欄的左邊不會影響的

如果5.修改程式增加公式數量，那6.的部分要修改嗎??
5增加公式數量，當然 6.的部分要修改所增加公式數量
作者: 藍天麗池    時間: 2014-12-7 10:29

本帖最後由 藍天麗池 於 2014-12-7 10:38 編輯

回復 14# GBKEE

[attach]19723[/attach]
    G大我把要改版的程式上傳，麻煩你幫我看一下
如果照G大說的我有200個程式不就要打200列??    :'(  
附件中我要執行的就是8:45將公式寫到J2-J202，等到8:46將公式寫到K2-K202、且將J2-J202的公式寫成值，以此類推一直執行到最右邊也就是執行到13:45
上述部分有比較簡單的寫法嗎??

另外我可以跟G大交個朋友嗎??G大有FB嗎??或是line?
作者: GBKEE    時間: 2014-12-7 14:26

本帖最後由 GBKEE 於 2014-12-7 14:30 編輯

回復 15# 藍天麗池
VBA公式文字可用巨集錄製: 在公式所在的儲存格作輸入的動作
  1. Sub RecordPrice()
  2.     Dim i As Integer, 公式(1 To 2)
  3.     i = Cells(2, Columns.Count).End(xlToLeft).Column
  4.     公式(1) = "=MATCH(R[-1]C,R3C6:R50000C6,0) + 1"
  5.     公式(2) = "=IF(SUMIF(INDIRECT(""D""&R2C[-1]+1):INDIRECT(""D""&R2C),RC9,INDIRECT(""E""&R2C[-1]+1):INDIRECT(""E""&R2C))=0,"""",SUMIF(INDIRECT(""D""&R2C[-1]+1):INDIRECT(""D""&R2C),RC9,INDIRECT(""E""&R2C[-1]+1):INDIRECT(""E""&R2C)))"
  6.     With Range("J2")
  7.         If .Value = "" Then
  8.             .Cells = 公式(1)         '你的公式"
  9.             .Cells(2).Resize(200) = 公式(2)
  10.         ElseIf i >= .Column Then      '
  11.             Cells(2, i) = Cells(2, i).Value
  12.             Cells(3, i).Resize(200) = Cells(3, i).Resize(200).Value
  13.             Cells(2, i + 1) = 公式(1)
  14.             Cells(3, i + 1).Resize(200) = 公式(2)
  15.         End If
  16.     End With
  17. End Sub
複製代碼
作者: 藍天麗池    時間: 2014-12-8 18:02

本帖最後由 藍天麗池 於 2014-12-8 18:14 編輯

回復 16# GBKEE


    G大感謝你，G大請教一下裡面好像沒有看到時間的設定，之前有設定從8:45開始到13:45結束，這次沒看到，是已經寫在裡面了嗎?
作者: GBKEE    時間: 2014-12-8 20:41

回復 17# 藍天麗池

之前有設定從8:45開始到13:45結束，這次沒看到
Sub RecordPrice() 套上不就可以了嗎?
你對VBA應該有認識了,多練習一下就會進步的.
作者: 藍天麗池    時間: 2014-12-8 21:08

回復 18# GBKEE


    G大我修改完成了感謝你的幫助，感激不盡
作者: 藍天麗池    時間: 2014-12-10 23:56

[attach]19742[/attach]回復 18# GBKEE


    請問G大有遇過這種情況嗎??裡面的表單(登入、接收資料...)都不能點，是不是有設定到什麼?
作者: GBKEE    時間: 2014-12-11 06:20

本帖最後由 GBKEE 於 2014-12-11 06:24 編輯

回復 20# 藍天麗池

問題出在這些券商的 API 函數  http://www.coco-in.net/thread-24599-1-1.html
請再自行詢問券商如何解決.
  1. Declare Function SKQuoteLib_Initialize Lib "SKQuoteLib.dll" (ByRef strID As Byte, ByRef strPass As Byte) As Long
  2. Declare Function SKQuoteLib_EnterMonitor Lib "SKQuoteLib.dll" () As Long
  3. Declare Function SKQuoteLib_AttachConnectionCallBack Lib "SKQuoteLib.dll" (ByVal Func As Long) As Long
  4. Declare Function SKQuoteLib_AttachQuoteCallBack Lib "SKQuoteLib.dll" (ByVal Func As Long) As Long
  5. Declare Function SKQuoteLib_AttachTicksCallBack Lib "SKQuoteLib.dll" (ByVal Func As Long) As Long
  6. Declare Function SKQuoteLib_AttachBest5CallBack Lib "SKQuoteLib.dll" (ByVal Func As Long) As Long
  7. Declare Function SKQuoteLib_RequestStocks Lib "SKQuoteLib.dll" (ByRef Page As Integer, ByVal Stocks As String) As Long
  8. Declare Function SKQuoteLib_RequestTicks Lib "SKQuoteLib.dll" (ByRef Page As Integer, ByVal Stock As String) As Long
  9. Declare Function SKQuoteLib_GetStockByNo Lib "SKQuoteLib.dll" (ByVal strStockNo As String, ByRef Stock As TStock) As Long
  10. Declare Function SKQuoteLib_GetStockByIndex Lib "SKQuoteLib.dll" (ByVal Market As Integer, ByVal Index As Integer, ByRef Stock As TStock) As Long
  11. Declare Function SKQuoteLib_GetTick Lib "SKQuoteLib.dll" (ByVal Market As Integer, ByVal Index As Integer, ByVal Ptr As Long, ByRef Tick As TTick) As Long
  12. Declare Function SKQuoteLib_GetBest5 Lib "SKQuoteLib.dll" (ByVal Market As Integer, ByVal Index As Integer, ByRef Best5 As TBest5) As Long
  13. Declare Function SKQuoteLib_AttachTicksGetCallBack Lib "SKQuoteLib.dll" (ByVal Func As Long) As Long
  14. Declare Function SKQuoteLib_AttachBest5GetCallBack Lib "SKQuoteLib.dll" (ByVal Func As Long) As Long
  15. Declare Function SKQuoteLib_GetKLine Lib "SKQuoteLib.dll" (ByVal strStockNo As String, ByVal KLineType As Integer) As Long
  16. Declare Function SKQuoteLib_AttachKLineDataCallBack Lib "SKQuoteLib.dll" (ByVal Func As Long) As Long
  17. Declare Function SKQuoteLib_RequestServerTime Lib "SKQuoteLib.dll" () As Long
  18. Declare Function SKQuoteLib_GetServerTime Lib "SKQuoteLib.dll" (ByRef ServerTime As CFormat05) As Long
  19. Declare Function SKQuoteLib_AttchServerTimeCallBack Lib "SKQuoteLib.dll" (ByVal Func As Long) As Long
複製代碼
作者: 藍天麗池    時間: 2014-12-11 07:37

本帖最後由 藍天麗池 於 2014-12-11 07:39 編輯

回復 21# GBKEE

G大，不是券商的問題，我昨天下午還可以用，但昨天開teamview後表單的部分就無法點擊，我在想是不是程式有衝到，上網查了一下不知道是否是activeX控制項的問題，所以才想說來請教G大，因為我不是只有那個檔案不行，是所有檔案的表單都無法點擊
作者: vavashop    時間: 2014-12-12 14:22

可以也分享給我？
我最近也在想這問題
謝謝
作者: 藍天麗池    時間: 2014-12-22 23:24

本帖最後由 藍天麗池 於 2014-12-22 23:25 編輯

回復 21# GBKEE


    G大，請教一下如果我在附件這個程式要加入每秒向下滾動一列要怎麼加呢??[attach]19905[/attach]
感謝
作者: 藍天麗池    時間: 2014-12-23 15:50

回復 21# GBKEE


    G大，可以順便幫小弟看一下這個附件嗎??[attach]19917[/attach]
小弟試著寫，本來功能設定是B2-K2其中的值大於700就記錄，但不知道發生甚麼問題，卻無法執行，值沒有到700也記錄，在麻煩G大幫忙指教一下
作者: GBKEE    時間: 2014-12-24 12:02

本帖最後由 GBKEE 於 2014-12-24 12:29 編輯

回復 25# 藍天麗池
試試看
  1. Option Explicit
  2. Sub RecordPrice()
  3.     Dim WR As Long, I As Byte, SH As Worksheet
  4.     Set SH = shtRTD '工作表物件模組的名稱
  5.     Set SH = Sheets("RTD") '活頁簿工作表的名稱
  6.     With SH
  7.         .Activate
  8.         If IsError(.Range("F2")) Or IsError(.Range("G2")) Then Exit Sub
  9.         If .Range("F2") < 20 Then Exit Sub
  10.         WR = .Range("A1").End(xlDown).Row + 1
  11.         If WR = 3 Or Application.Max(.Range("B2").Resize(, 10)) > 700 Then
  12.             .Cells(WR, 1).Resize(, 11) = .Range("A2").Resize(, 11).Value
  13.             With ActiveWindow
  14.                 If Intersect(SH.Cells(WR, "A"), .VisibleRange) Is Nothing Then
  15.                     SH.Cells(WR, "A").Select
  16.                 End If
  17.             End With
  18.         End If
  19.     End With
  20. End Sub
複製代碼
作者: 藍天麗池    時間: 2014-12-24 13:28

回復 26# GBKEE

G大感謝你等等來試試看
作者: 藍天麗池    時間: 2014-12-24 22:13

回復 26# GBKEE

G大，之前的程式測試過後可以了，但是另一個請教一下G大如果我在附件這個程式要加入每秒向下滾動一列要怎麼加呢?? [attach]19936[/attach]
其他的我還可以試著寫寫看，但這種的就...，還望G大幫忙一下，不好意思G大總是麻煩你
作者: GBKEE    時間: 2014-12-25 08:23

本帖最後由 GBKEE 於 2014-12-25 08:48 編輯

回復 28# 藍天麗池

是這樣嗎?
  1. Sub RecordPrice()
  2.     Dim WR As Long, R As Long
  3.     Dim I As Long
  4.     WR = Range("A1").End(xlDown).Row + 1
  5.     [A2] = TimeValue(Now)
  6.     For I = 1 To 24
  7.         Cells(WR, I) = Cells(2, I)
  8.     Next 'I
  9.     With ActiveWindow
  10.         If Intersect(Cells(WR, "A"), .VisibleRange) Is Nothing Then
  11.            Cells(WR, "A").Select
  12.         End If
  13.         .SmallScroll .VisibleRange.Cells.End(xlDown).Row - .VisibleRange.Cells(1).Row
  14.     End With
  15. End Sub
複製代碼
還是這樣?
  1. With ActiveWindow
  2.         If Intersect(Cells(WR, "A"), .VisibleRange) Is Nothing Then .SmallScroll 1
  3.     End With
複製代碼
作者: 藍天麗池    時間: 2014-12-25 16:29

回復 29# GBKEE

G大是下面那樣，謝謝你
作者: 藍天麗池    時間: 2015-1-6 10:31

本帖最後由 藍天麗池 於 2015-1-6 10:36 編輯

回復 29# GBKEE

G大跟你請教一下，我有一個程式因為excel裡面的資料比較多，需要一直更新，但畫面會一直閃爍，我在網路上找了一下，說是要貼上下面的兩段程式碼，但我不確定貼在哪哩，請G大跟我說一下，感謝

Application.ScreenUpdating = False
Application.ScreenUpdating = True

我有幾段程式貼出來給G大看，在麻煩您跟我說一下，感謝

以下是sheet4
  1. Private Sub CommandButton1_Click()
  2.     Dim pTick As TTick
  3.     Dim I As Integer
  4.     I = 1
  5.     Sheet4.Range("g1:g2").Clear
  6.     Sheet4.Range("a3:f3").Clear
  7.     Sheet4.Range("a5:k90000").Clear
  8.       While Sheet4.Cells(2, I) <> ""
  9.         Status = SKQuoteLib_RequestTicks(I, Sheet4.Cells(2, I))
  10.         I = I + 1
  11.     Wend
  12. End Sub
  13. Private Sub Worksheet_Change(ByVal Target As Range)
  14.     Application.EnableEvents = False
  15.     If Not Intersect(Target, [B5:B90000]) Is Nothing Then
  16.         Range("H" & Target.Row).Formula = "=INT(RC[-6]/100)"
  17.       
  18.      ElseIf Not Intersect(Target, [F5:F90000]) Is Nothing Then
  19.         Range("I" & Target.Row).Formula = "=IF(RC[-6]=-9999.99,R[-3]C[-4],IF(RC[-4]=RC[-6],-RC[-3],IF(RC[-4]=RC[-6]-1,-RC[-3],IF(RC[-4]=RC[-6]-2,-RC[-3],IF(RC[-4]=RC[-6]-3,-RC[-3],IF(RC[-4]=RC[-6]-4,-RC[-3],IF(RC[-4]=RC[-6]-5,-RC[-3],IF(RC[-4]=RC[-5],RC[-3],IF(RC[-4]=RC[-5]+1,RC[-3],IF(RC[-4]=RC[-5]+2,RC[-3],IF(RC[-4]=RC[-5]+3,RC[-3],IF(RC[-4]=RC[-5]+4,RC[-3],IF(RC[-4]=RC[-5]+5,RC[-3],RC[-3])))))))))))))"
  20.      ElseIf Not Intersect(Target, [C5:C90000]) Is Nothing Then
  21.         Range("J" & Target.Row).Formula = "=IF(RC[-1]>0,RC[-4],R1C)"
  22.      ElseIf Not Intersect(Target, [D5:D90000]) Is Nothing Then
  23.         Range("K" & Target.Row).Formula = "=IF(RC[-2]<0,RC[-5],R1C[-1])"
  24.    End If
  25.    Application.EnableEvents = True
  26.         

  28. End Sub
複製代碼
以下是thisworkbook
  1. Option Explicit

  3. Private Sub Workbook_BeforeClose(Cancel As Boolean)
  4. Application.RTD.ThrottleInterval = 2000
  5. Application.Calculation = xlCalculationAutomatic
  6. End Sub

  8. Private Sub Workbook_Open()
  9. Const StartTime As Date = "08:45:00"

  11. Application.RTD.ThrottleInterval = 0
  12. Application.Calculation = xlCalculationManual

  14. Application.OnTime StartTime, "mySchedule"
  15. End Sub
複製代碼
以下是模組2
  1. Option Explicit
  2. Dim NextTime As Date

  4. Sub RecordPrice()
  5. Calculate
  6. End Sub

  8. Sub mySchedule()
  9. Const StopTime As Date = "14:30:00"

  11. NextTime = Now + TimeValue("00:00:02")
  12. If TimeValue(NextTime) <= StopTime Then
  13.    Application.OnTime EarliestTime:=TimeValue(NextTime), Procedure:="mySchedule"
  14. End If
  15. Call RecordPrice
  16. End Sub

  18. Sub Macro1()
  19. Sheet4.Range("g1:g2").Clear
  20. Sheet4.Range("a3:f3").Clear
  21. Sheet4.Range("a5:i90000").Clear

  23. End Sub
複製代碼
原則上只用到這幾個，在請G大跟我說上面那兩行加在哪裡可以讓畫面不再閃爍
作者: 藍天麗池    時間: 2015-1-6 12:41

回復 29# GBKEE
G大，情況就大概像影片中的樣子，會一直閃個不停
http://youtu.be/HkWukKMe2_A
作者: GBKEE    時間: 2015-1-11 16:34

回復 32# 藍天麗池
試試看
  1. Sub RecordPrice()
  2.     Application.ScreenUpdating = False
  3.     Calculate
  4.     Application.ScreenUpdating = True
  5. End Sub
複製代碼
作者: 藍天麗池    時間: 2015-1-11 17:03

回復 33# GBKEE


    感謝G大
作者: 藍天麗池    時間: 2015-1-20 18:08

回復 33# GBKEE

G大不好意思又來請教你了
    http://forum.twbts.com/viewthread.php?tid=13250&extra=



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)