藍天麗池

回復 40# c_c_lai


    可以記錄，但不可統計，C大謝謝，我想我還是改用API+EXCEL的方式進行好了，不用再費心了，真的非常的謝謝妳

GBKEE

回復 38# 藍天麗池

附檔試試看看另一作法

EX.rar (28.72 KB)

下載次數: 9

2016-2-3 10:33

   

下載 (158.41 KB)

2016-2-3 09:46

ThisWorkbook模組

1. Option Explicit
   
2. Private Sub Workbook_BeforeClose(Cancel As Boolean) '
   
3.     '檔案關閉:關閉檔案連結
   
4.     '**檔案在開啟時,不啟動詢問更新資料的視窗
   
5.    
   
6.     ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
   
7.     'UpdateLinks 屬性 傳回或設定 XlUpdateLink 常數，此常數可指出活頁簿更新內嵌 OLE 連線的設定。讀/寫。
   
8.    
   
9.     'XlUpdateLinks 可以是這些 XlUpdateLinks 常數之一。
   
10.     'xlUpdateLinksAlways 永遠更新指定活頁簿的內嵌 OLE 連線。
    
11.     'xlUpdateLinksNever 永遠不更新指定活頁簿的內嵌 OLE 連線。
    
12.     'xlUpdateLinksUserSetting  根據使用者對指定活頁簿的設定來更新內嵌的 OLE 連線。
    
13. End Sub
    
14. 
    
15. Private Sub Workbook_Open()
    
16.     Application.Calculation = xlAutomatic  ' 活頁簿設為自動重算
    
17.     '檔案在開啟時:自動更新連結
    
18.     With ActiveWorkbook
    
19.         .UpdateRemoteReferences = True
    
20.         .SaveLinkValues = True
    
21.     End With
    
22. End Sub

複製代碼

Sheet1(Sheets("RTD")) 模組的程式碼

1. Option Explicit
   
2. Dim D As Object, xTime As Date, Volume As Double
   
3. Private Sub Worksheet_Calculate()
   
4.     If IsError([E2]) Or Time < #8:45:00 AM# Then Application.StatusBar = "等候開盤中": Exit Sub
   
5.    
   
6.     '[E2] = "--" 開盤前的符號
   
7.    If Volume <> [E2] And [E2] <> "--" And Time >= #8:45:00 AM# And Time < #1:46:00 PM# Then
   
8.         If D Is Nothing Then
   
9.             Application.OnTime #1:46:00 PM#, "SHEET1.紀錄"  '收盤後強制寫出最後一分鐘的資料
   
10.             Application.StatusBar = False
    
11.             Set D = CreateObject("scripting.dictionary")
    
12.             Range("A" & Rows.Count).End(xlUp).CurrentRegion.Offset(1) = ""
    
13.             Sheets("紀錄").UsedRange.Clear
    
14.             xTime = TimeSerial(Hour(Time), Minute(Time), 0)
    
15.         End If
    
16.         If TimeSerial(Hour([B2]), Minute([B2]), 0) <> xTime And D.Count > 0 Then 紀錄 '下一分鐘開始時,紀錄上一分鐘的紀錄
    
17.         D([C2].Value) = D([C2].Value) + IIf([D2] <= 10, -1, 1)    '字典物件:紀錄成交單量公式的值
    
18.         Volume = [E2]
    
19.         xTime = TimeSerial(Hour([B2]), Minute([B2]), 0)
    
20.         '**************** 記錄每次成交紀錄***************
    
21.          With Range("A" & Rows.Count).End(xlUp).Offset(1)
    
22.             .Cells(1) = [B2]                        '時間
    
23.             .Cells(1, 2) = [C2]                     '成交價
    
24.             .Cells(1, 3) = [D2]                     '成交單數
    
25.             .Cells(1, 4) = IIf([D2] <= 10, -1, 1)   '成交單量公式的值
    
26.         End With
    
27.         '************************************************
    
28.     End If
    
29. End Sub
    
30. Private Sub 紀錄()
    
31.     Dim R As Integer, C As Integer, X As Integer
    
32.     Application.EnableEvents = False
    
33.     With Sheets("紀錄")
    
34.         If .[A1] = "" Then .[A1] = "時間"
    
35.         With .Range("A" & .Rows.Count).End(xlUp).Offset(1)
    
36.             R = .Row
    
37.             .NumberFormat = "HH:MM"
    
38.             .Value = xTime
    
39.             .Resize(2).Merge
    
40.         End With
    
41.         C = 2
    
42.         '迴圈:字典物件的KEY(關鍵字) 最大值 - 最小值.
    
43.         For X = Application.Max(D.KEYS) To Application.Min(D.KEYS) Step -1
    
44.             If D.EXISTS(X) Then   '字典物件有這個KEY(關鍵字)
    
45.                 If .Cells(1, C) = "" Then .Cells(1, C) = C - 1
    
46.                 .Cells(R, C) = X
    
47.                 .Cells(R, C).Interior.ColorIndex = 40
    
48.             
    
49.                 .Cells(R + 1, C) = D(X)
    
50.                 C = C + 1
    
51.             End If
    
52.         Next
    
53.     End With
    
54.     D.RemoveAll   '重設,字典物件(紀錄成交價的公式的值)
    
55.    
    
56.    '這行的程式碼可刪除上一分鐘的資料,加速程式的運行
    
57.     Range("A" & Rows.Count).End(xlUp).CurrentRegion.Offset(1) = ""    '如要保留可註解掉不必執行
    
58.     Application.EnableEvents = True
    
59. End Sub

複製代碼

藍天麗池

回復 42# GBKEE


    G大今天台股封關了，要試也要等過年後了，謝謝妳

jackyq

回復 43# 藍天麗池


    封關一樣可試

藍天麗池

回復 40# c_c_lai

http://forum.twbts.com/viewthread.php?tid=16452&extra=
C大新年快樂，有空可以麻煩幫我看看嗎??