c_c_lai

回復 1# 藍天麗池
在 shtRTD (RTD) 表單內 RecordPrice()
加入 STSumifs WR, WR， 如下：

1. Option Explicit
   
2. 
   
3. Sub RecordPrice()
   
4.     Dim WR As Long
   
5.     Dim I As Byte
   
6. 
   
7.     If Range("P2") < 1 Then Exit Sub
   
8. 
   
9.     WR = Range("A1").End(xlDown).Row + 1
   
10.     '  ActiveWindow.ScrollRow = WR - 5     '  只顯示最新幾筆資料
    
11.     If (WR = 3) Or _
    
12.             (Range("F" & WR - 1) <> Range("F2")) Then   '  總量有異動時才記錄
    
13.         For I = 1 To 6
    
14.             Cells(WR, I) = Cells(2, I)
    
15.         Next 'I
    
16.         
    
17.         STSumifs WR, WR                         '  資料同步將數值寫入到 R，S，T 三欄內
    
18.     End If
    
19.     '  With ActiveWindow
    
20.         '  If Intersect(Cells(WR, "B"), .VisibleRange) Is Nothing Then .SmallScroll 5
    
21.     '  End With
    
22. End Sub
    
23. 
    
24. Private Function STSumifs(ByVal endST As Long, Optional startST As Long = 3)
    
25.     Dim cts As Long
    
26.     Dim btm As Long
    
27.    
    
28.     btm = Range("A1").End(xlDown).Row
    
29.    
    
30.     For cts = startST To endST
    
31.         Cells(cts, "R") = IIf(cts = 2, "", IIf(cts = 3, "=MAX(B3:B" & btm & ")", "=R" & (cts - 1) & "-1"))
    
32.         Cells(cts, "R") = Cells(cts, "R").Value
    
33.         Cells(cts, "S") = "=IF(SUMIFS($E3:$E" & btm & ",$D3:$D" & btm & ",S$1,$B3:$B" & btm & ",$R" & (cts - 1) & ")=0," & Chr(34) & Chr(34) & ",SUMIFS($E3:$E" & btm & ",$D3:$D" & btm & ",S$1,$B3:$B" & btm & ",$R" & (cts - 1) & "))"
    
34.         Cells(cts, "S") = Cells(cts, "S").Value
    
35.         Cells(cts, "T") = "=IF(SUMIFS($E3:$E" & btm & ",$D3:$D" & btm & ",T$1,$B3:$B" & btm & ",$R" & (cts - 1) & ")=0," & Chr(34) & Chr(34) & ",SUMIFS($E3:$E" & btm & ",$D3:$D" & btm & ",T$1,$B3:$B" & btm & ",$R" & (cts - 1) & "))"
    
36.         Cells(cts, "T") = Cells(cts, "T").Value
    
37.     Next cts
    
38. End Function
    
39. 
    
40. Sub Test()
    
41.     Dim WR As Long
    
42.    
    
43.     WR = Range("A1").End(xlDown).Row
    
44.     STSumifs WR
    
45. End Sub

複製代碼

最後面之 Test() 是可讓你一次自動執行更換 第 3 行 ~ 第 4903 行
R，S，T 三欄的資料值。如果不異動的話，就不需執行它。
其它程式部分均保留原貌。因我無券商連線無法測知狀況。

c_c_lai

回復 1# 藍天麗池
請參考：
如何把個股每 5 分鐘的成交價格記錄下來？

c_c_lai

回復 6# 藍天麗池
說真的，我不太懂 SUMIFS 的用意，只是依樣畫葫。
如你有時間的話，稍稍說明一下它的使用方式與你的想法，
如此會更明瞭其作用，謝謝。

c_c_lai

回復 12# 藍天麗池
這是你原本的定義：

1. S3
   
2. =IF(SUMIFS($E:$E,$D:$D,S$1,$B:$B,$R2)=0,"",SUMIFS($E:$E,$D:$D,S$1,$B:$B,$R2))
   
3. T3
   
4. =IF(SUMIFS($E:$E,$D:$D,T$1,$B:$B,$R2)=0,"",SUMIFS($E:$E,$D:$D,T$1,$B:$B,$R2))

複製代碼

這是程式碼解析的結果：

1. S3
   
2. =IF(SUMIFS($E3:$E4903,$D3:$D4903,S$1,$B3:$B4903,$R2)=0,"",SUMIFS($E3:$E4903,$D3:$4903,S$1,$B3:$B4903,$R2))
   
3. T3
   
4. =IF(SUMIFS($E3:$E4903,$D3:$D4903,T$1,$B3:$B4903,$R2)=0,"",SUMIFS($E3:$E4903,$D3:$D4903,T$1,$B3:$B4903,$R2))

複製代碼

然後再轉為數值表示。

c_c_lai

回復 14# 藍天麗池
Function STSumifs(ByVal endST As Long, Optional startST As Long = 3)
1.  Optional startST As Long = 3 的用意，事先賦予預設值；
    例如:
    Sub Test()
        Dim WR As Long
   
        WR = Range("A1").End(xlDown).Row   '  最後一筆資料列
        STSumifs WR
    End Sub
    在 STSumifs 的函式中：
        For cts = startST To endST
    startST 等於 3， endST  等於 WR (4903)
    此時 STSumifs WR = STSumifs WR, 3 之意，
    Optional  的變數宣告，如未帶入值，則以其
   設定的預設值 (3) 為參數值。
    ***  這是一次就處理 3 ~ 4903 完畢。
     
2.  假設帶入值為：
    WR = Range("A1").End(xlDown).Row + 1 '  最後一筆資料列 + 1
    STSumifs WR, WR
    startST 等於 WR， endST  等於 WR (4094)
    ***  這是將資料寫入到資料錄的最後列。

c_c_lai

回復 20# 藍天麗池
你說的 "昨天7樓的附件經測試後無法記錄價格"，
7樓 那來的附件？
你指的是？

1. Sub RecordPrice()
   
2.     Dim WR As Long
   
3.    Dim I As Byte
   
4. 
   
5.    If Range("P2") < 1 Then Exit Sub
   
6.     WR = Range("A1").End(xlDown).Row + 1
   
7.    '  ActiveWindow.ScrollRow = WR - 5     '  只顯示最新幾筆資料
   
8.     If (WR = 3) Or _
   
9.            (Range("F" & WR - 1) <> Range("F2")) Then   '  總量有異動時才記錄
   
10. 
    
11. .        For I = 1 To 6
    
12.             Cells(WR, I) = Cells(2, I)
    
13.        Next 'I
    
14.         STSumifs WR, WR                         '  資料同步將數值寫入到 R，S，T 三欄內
    
15.   End If
    
16.    '  With ActiveWindow
    
17.         '  If Intersect(Cells(WR, "B"), .VisibleRange) Is Nothing Then .SmallScroll 5
    
18.     '  End With
    
19. End Sub

複製代碼

你的程式碼中有加入這一行嗎？

1. STSumifs WR, WR                         '  資料同步將數值寫入到 R，S，T 三欄內

複製代碼

你的原始碼是在 Workbook_Calculate() 裡執行的，
請檢查一下。
准提部林版大的分享亦值得你研究參考，你想要的答案
是不是那樣？
我的程式碼 STSumifs() 只是將你本來之公式 (Formula) 以程式模式與資料同步寫入
而已，沒做任何之延伸創意。因為我不懂你公式的作用。看了准提部林版大的分享
才稍稍明瞭你要的結果可能會是如此，還是另有想法？

c_c_lai

回復 22# 藍天麗池

下載 (51.86 KB)

2016-1-28 12:56

c_c_lai

回復 24# 藍天麗池
你把你目前的Excel檔案壓縮上傳，
眼見為憑！

c_c_lai

回復 26# 藍天麗池
你說 "可以記錄，但卻不是我原本設定的變動才紀錄"
此話怎說？
你開啟檔案後，它會從 DDE 匯入即時數據，接著它便自動判斷
總量有異動時才記錄，這個過程不對嗎？"不是你原本設定的變動才紀錄"
是甚麼情形，因我沒券商的軟體所以無從得知差異在那裏。

c_c_lai

回復 28# 藍天麗池
那你再觀察一下 F2 欄的數據有沒有一直在變動？
如沒，則你必須重新再次啟動券商的軟體。