- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
33#
發表於 2018-11-6 18:59
| 只看該作者
回復 32# dreamsway
試試看- Option Explicit
- Const 間隔 = #12:05:00 AM# '這裡修改分鐘間隔
- Const 開盤 = #8:45:00 AM#
- Public Sht2 As Worksheet
- Sub K心態()
- Dim i As Long, Ti As Integer, 成交價 As Double, 多總 As Long, 空總 As Long, 方向 As String
- Dim xTime As Date, wTime As Date, Q As Variant
- '*************************************
- Set Sht2 = Sheets("報價數據")
- With Sht2
- For Each Q In .QueryTables
- Q.Delete
- Next
- For Each Q In .Names
- Q.Delete
- Next
- End With
- 匯入API報價文字檔
- '**************************************
- xTime = 開盤 + 間隔
- i = 1: Ti = 0: 多總 = 0: 空總 = 0
- 成交價 = Sheets("多空藍圖").Range("M4") '欄位暫代
- Do
- With Sht2.Range("b1").Offset(i)
- '**間隔為 #12:05:00 AM# 這"↑","↓"數據 準確嗎?***
- If 成交價 < .Cells(1, 2) Then 方向 = "↑"
- If 成交價 > .Cells(1, 2) Then 方向 = "↓"
-
- If 成交價 <= .Cells(1, 2) And 方向 = "↑" Then 多總 = 多總 + .Cells(2, 3)
- If 成交價 >= .Cells(1, 2) And 方向 = "↓" Then 空總 = 空總 + .Cells(2, 3)
- 成交價 = .Cells(1, 2)
- If .Value > xTime + 間隔 Then
- With Sheets("測試").Range("A2").Offset(Ti)
- .Resize(, 3) = Array(xTime, 多總, 空總)
- .NumberFormatLocal = "hh:mm;@"
- End With
- xTime = xTime + 間隔: Ti = Ti + 1
- Else
- If .Cells.Offset(1) = "" And Format(TimeValue(.Cells.Text), "HH:MM") = "13:45" Then
- '***程式運行速度很快會跑完報價數據,時間已到"13:45"收盤 不再有數據了 **
- xTime = xTime + 間隔
- With Sheets("測試").Range("A2").Offset(Ti)
- .Resize(, 3) = Array(xTime, 多總, 空總)
- .NumberFormatLocal = "hh:mm;@"
- End With
- Exit Do
- ElseIf .Cells.Offset(1) = "" Then
- '****程式運行速度很快會跑完報價數據,但是數據還會有 因時間還未到"13:45"收盤 時 ... **
- '**程式到這理 執行 重新整理 的程式 有更新到 _20180724_Match 對嗎? **
- '**********************************************
- wTime = Time
- Do
- If wTime < Time - #12:00:30 AM# Then '30秒 重新整理 一次
- '**試稍待一下等候新的數據
- Application.StatusBar = "重新整理...."
- 匯入API報價文字檔 '** 更新 _20180724_Match 如有新的資料進來
- '*************************.Cells.Offset(1)就 <>"" ***
- wTime = Time
- End If
- DoEvents
- Loop While .Cells.Offset(1) = "" '**還是沒有新的數據就一直等候...
- '*** 如有新的資料進來 離開迴圈 繼續下去到 i = i + 1 的地方 再 Loop 下去 ***
- Application.StatusBar = False
- End If
- End If
- End With
- DoEvents
- i = i + 1
- Loop
- MsgBox "工作完成"
- End Sub
- Sub 匯入API報價文字檔() '還沒調整路徑字串，路徑2組日期改為當日日期，TXFH8則為sht1多空藍圖的A4儲存格
- With Sht2
- If .QueryTables.Count = 0 Then
- With .QueryTables.Add(Connection:= _
- "TEXT;C:\API\20180724\TXFH8\20180724_Match.txt", Destination:=.Range("$A$2"))
- .Name = "20180724_Match"
- '.FieldNames = True '預設值為 True 可不用列出
- .RowNumbers = False
- .FillAdjacentFormulas = False
- '.PreserveFormatting = True '預設值為 True。可不用列出
- '.RefreshOnFileOpen = False '預設值為 False。可不用列出
- .RefreshStyle = xlInsertDeleteCells
- .SavePassword = False
- .SaveData = True
- '.AdjustColumnWidth = True '預設值為 True。可不用列出
- .RefreshPeriod = 0
- '.TextFilePromptOnRefresh = False '預設值為 False。可不用列出
- .TextFilePlatform = 950
- .TextFileStartRow = 1
- .TextFileParseType = xlDelimited
- .TextFileTextQualifier = xlTextQualifierDoubleQuote
- '.TextFileConsecutiveDelimiter = False '預設值為 False 。可不用列出
- .TextFileTabDelimiter = True
- '.TextFileSemicolonDelimiter = False '預設值為 False 。可不用列出
- .TextFileCommaDelimiter = True
- '.TextFileSpaceDelimiter = False '預設值為 False 。可不用列出
- .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
- .TextFileTrailingMinusNumbers = True
- .Refresh BackgroundQuery:=False
- End With
- Else
- .QueryTables(1).Refresh
- End If
- .Columns("B:B").NumberFormatLocal = "h:mm:ss;@"
- End With
- End Sub
|
|
發表於 2018-11-6 17:04
| 
