[發問] 算漲跌與均價

daniel5168

請教各位先進,我用DDE紀錄價位,要如何可以同時記錄這分鐘與上分鐘的漲跌與均價,怕口條不好解釋不清以下附圖

下載 (23.88 KB)

2015-7-31 17:29

漲跌與均價也是要每分鐘往下紀錄的,那D2跟E2的格子該怎麼寫公式
台指近一分鐘即時記錄.rar (28.24 KB)

下載次數: 12

2015-7-31 17:43

ken2192

漲跌的定義應該是(這分鐘成交價-上分鐘成交價)/上分鐘成交價

daniel5168

回復 2# ken2192
但是我要在D2跟E2計算出每分鐘的變化,然後往下每分鐘紀錄,我不知道該如何現在價格建去上一分鐘價格,因為上一分鐘價格的儲存格位置不段改變

daniel5168

請問一下各位先進,我上述想法是不是無法做到,只能用C欄已經記錄的資料在D欄以及E欄用函數計算呢?
因怕函數公式太多會導致越來越遲鈍,所以想問問是否有可能在D2以及E2就把數據算出來再讓VBA的每分紀錄去寫在D3跟E3往下欄位

GBKEE

回復 4# daniel5168

試試看

1. Sub 自動記錄()
   
2.     Dim Rng As Range, 漲跌 As Single, 均價 As Single
   
3.     If uMode = 0 Then Exit Sub
   
4.     With Sht1
   
5.         If Time > TimeValue(EndTime) Then '收盤時間以後不執行
   
6.             .[O8] = "已過收盤"
   
7.             uMode = 0
   
8.             Exit Sub
   
9.         End If
   
10.         '----------------------------------------------------------
    
11.         Set Rng = .Range("A65536").End(xlUp).Offset(1)
    
12.         .Range("A" & Rng.Row & ":C" & Rng.Row).Value = .Range("A2:C2").Value
    
13.         With .Cells(Rng.Row, "C")   '
    
14.             '漲跌的定義應該是(這分鐘成交價-上分鐘成交價)/上分鐘成交價
    
15.             If .Row >= 4 Then 漲跌 = (.Cells - .Cells.Offset(-1)) / .Cells.Offset(-1)
    
16.             '20單位週期均價
    
17.             If .Row >= 22 Then 均價 = Application.WorksheetFunction.Average(.Cells.Offset(-19).Resize(20))
    
18.         End With
    
19.         .Range("D2") = IIf(漲跌 <> 0, 漲跌, "")
    
20.         .Range("E2") = IIf(均價 <> 0, 均價, "")
    
21.         .Range("D" & Rng.Row & ":E" & Rng.Row).Value = .Range("D2:E2").Value
    
22.         '------------------------------------------------
    
23.     End With
    
24.     If ActiveSheet.Name = Sht1.Name And xRow > 8 Then
    
25.         ActiveWindow.ScrollRow = xRow - 6 '讓最新資料保持在可見視窗中
    
26.     End If
    
27.     Beep
    
28.     '------------------------------------------------
    
29.     ThisWorkbook.Save   '存檔
    
30.     Application.OnTime Now + TimeValue("00:00:01"), "自動記錄"   '每一秒遞迴一次
    
31. End Sub

複製代碼

daniel5168

回復 5# GBKEE
早上已經套入試用,但他好像是每秒記錄一次,我加入If Second(Time) = 0 And Minute(Time) Mod 1 = 0 Then
之後出現錯誤訊息如圖

下載 (39.22 KB)

2015-8-4 09:43

想它每秒地回一次又想每一分鐘記錄我該怎麼改,有勞指點了.我也一邊自己努力改改看

lpk187

回復 6# daniel5168


    你加了If Second(Time) = 0 And Minute(Time) Mod 1 = 0 Then卻沒有給它End If

GBKEE

回復 6# daniel5168


但他好像是每秒記錄一次,
這裡修改 Application.OnTime Now + TimeValue("00:01:00"), "自動記錄"   '每一分遞迴一次
可以不用 If Second(Time) = 0 And Minute(Time) Mod 1 = 0 Then 這行程式碼

錯誤訊息 沒有 With, lpk187 說了少了End If

daniel5168

回復 7# lpk187
多謝lpk187  大大,雖然不懂整個程式怎麼解讀,但是我打END IF嘗試在各個位置,終於成功

daniel5168

回復 8# GBKEE

多謝GBKEE  版主幫忙解答,經過您的編寫,我亂改出問題,lpk187大大的指點,我再亂改,終於測試成功

下載 (29.29 KB)

2015-8-4 15:18

1. Public uMode&, StartTime, EndTime
   
2. Public MyBook As Workbook, Sht1 As Worksheet, Sht2 As Worksheet, xRow&
   
3. 
   
4. Sub 共用參照()
   
5. Set MyBook = ThisWorkbook
   
6. Set Sht1 = MyBook.Sheets("台指近一分鐘線")
   
7. StartTime = "08:44:50"  '開盤時間（提早十秒開始，才可記錄開盤量價）"08:44:50"
   
8. EndTime = "21:45:10"    '收盤時間（延後十秒停止記錄）此為測試用時間，請自行更改正式時間 "13:45:10"
   
9. End Sub
   
10. 
    
11. Sub 自動記錄()
    
12.     Dim Rng As Range, 漲跌 As Single, 均價 As Single
    
13.     If uMode = 0 Then Exit Sub
    
14.     With Sht1
    
15.         If Time > TimeValue(EndTime) Then '收盤時間以後不執行
    
16.             .[F2] = "已過收盤"
    
17.             uMode = 0
    
18.             Exit Sub
    
19.         End If
    
20.         Sht1.Range("B2") = Time '當前時間（時間碼表）
    
21.         '----------------------------------------------------------
    
22.         '每１分鐘記錄，５分鐘則改為 Mod 5
    
23.         If Second(Time) = 0 And Minute(Time) Mod 1 = 0 Then
    
24.         Set Rng = .Range("A65536").End(xlUp).Offset(1)
    
25.         .Range("A" & Rng.Row & ":C" & Rng.Row).Value = .Range("A2:C2").Value
    
26.         With .Cells(Rng.Row, "C")   '
    
27.             '漲跌的定義應該是(這分鐘成交價-上分鐘成交價)/上分鐘成交價
    
28.             If .Row >= 4 Then 漲跌 = (.Cells - .Cells.Offset(-1))
    
29.             '20單位週期均價
    
30.             If .Row >= 22 Then 均價 = Application.WorksheetFunction.Average(.Cells.Offset(-19).Resize(20))
    
31.         End With
    
32.         .Range("D2") = IIf(漲跌 <> 0, 漲跌, "")
    
33.         .Range("E2") = IIf(均價 <> 0, 均價, "")
    
34.         .Range("D" & Rng.Row & ":E" & Rng.Row).Value = .Range("D2:E2").Value
    
35.         End If
    
36.         '------------------------------------------------
    
37.     End With
    
38.     If ActiveSheet.Name = Sht1.Name And xRow > 8 Then
    
39.         ActiveWindow.ScrollRow = xRow - 6 '讓最新資料保持在可見視窗中
    
40.     End If
    
41.     Beep
    
42.     '------------------------------------------------
    
43.     ThisWorkbook.Save   '存檔
    
44.     Application.OnTime Now + TimeValue("00:00:01"), "自動記錄"   '每一秒遞迴一次
    
45. End Sub
    
46. Sub 開始執行()
    
47. If uMode = 1 Then Exit Sub
    
48. Call 共用參照
    
49. uMode = 1
    
50. Sht1.[F2] = "執行中"
    
51. Call 自動記錄
    
52. End Sub
    
53. 
    
54. Sub 停止執行()
    
55. uMode = 0
    
56. Call 共用參照
    
57. Sht1.[F2] = "STOP"
    
58. End Sub
    
59. 
    
60. Sub 清除記錄資料()
    
61. Beep
    
62. If MsgBox("※確定要清除〔Sheet1〕的記錄嗎？　", 4 + 32 + 256) = vbNo Then Exit Sub
    
63. Call 共用參照
    
64. Sht1.Rows("3:65536").ClearContents
    
65. If ActiveSheet.Name = Sht1.Name Then ActiveWindow.ScrollRow = 1
    
66. Beep
    
67. End Sub

複製代碼