Board logo

標題: [發問] 詢問一個紀錄開高低收價的VBA問題 [打印本頁]
作者: laieven    時間: 2015-7-6 01:38     標題: 詢問一個紀錄開高低收價的VBA問題

將程式寫在工作表事件程序Calculate中

a2資料來源會用dde連結看盤軟體的成交價

測試的時候我暫時把資歷來源設定為另一個excel檔案的a1儲存格

只要我改變資料~~~開高低收的紀錄算正常

但就是無法做到每一段固定時間(例如每1分鐘或每5分鐘甚至是每5秒)就換一列的這個動作

還請高手幫忙看一下∼~我錯在哪!!感謝!!

[attach]21325[/attach]
作者: GBKEE    時間: 2015-7-6 09:58

回復 1# laieven
試試看
  1. Option Explicit
  2. Private Sub Worksheet_Calculate()
  3.     Dim StartTime As Date, StopTime As Date
  4.     Dim T(1 To 3) As Double, xMax As Double, xMin As Double
  5.     Dim 成交價 As Range
  6.     Static Rng As Range, S As Integer
  7.    
  8.     StartTime = Range("A6") '開盤時間, 例如: "09:00:00 AM"
  9.     StopTime = Range("A7")  '收盤時間, 例如: "01:30:00 PM"
  10.     If Time <= StartTime Or Time > StopTime Then '尚未開盤 或 已經收盤
  11.         Set Rng = Nothing
  12.         Exit Sub
  13.     End If
  14.     Set 成交價 = Range("A2")
  15.      '****分鐘設定******
  16.     'T(1) = Application.Text(StartTime, "[M]")  '開盤時的分鐘數
  17.     'T(2) = Application.Text(Time, "[M]")       'Now的分鐘數
  18.     'T(3) = Round(((T(2) - T(1)) / 5))          '開盤後每時5分鐘的間隔次數
  19.       
  20.       '*** 秒數設定
  21.     T(1) = Application.Text(StartTime, "[S]")    '開盤時的秒數
  22.     T(2) = Application.Text(Time, "[S]")         'Now的秒數
  23.     T(3) = Round(((T(2) - T(1)) / 10))           '開盤後每10秒的間隔次數
  24.    
  25.     If Rng Is Nothing Then Set Rng = Range("D1").Resize(, 4)
  26.     xMax = Application.Max(Rng)                 '歷史最高價
  27.     xMin = Application.Min(Rng)                 '歷史最低價
  28.    
  29.     If S = T(3) Then                               '設定的時間間隔內
  30.         If 成交價 > xMax Then Rng.Cells(1, 2) = 成交價      '最高價
  31.         If 成交價 < xMin Then Rng.Cells(1, 3) = 成交價      '最高價
  32.         Rng.Cells(1, 4) = 成交價                            '收盤價
  33.     ElseIf S <> T(3) Then
  34.         Set Rng = Rng.Offset(1)                   '下一列
  35.         Rng.Resize(, 4) = 成交價
  36.         Cells(Rng.Row, "c") = Time  '查看時間的間隔,如不需要可刪除掉
  37.     End If
  38.     S = T(3)
  39. End Sub
複製代碼
作者: laieven    時間: 2015-7-6 11:57

版主熱情的協助,讓我大吃一驚阿!
再此先萬分感謝了!!!
我得花點時間消化一下版主的協助!!
感恩感恩!!!!!
學習去!!!



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