- 帖子
- 51
- 主題
- 17
- 精華
- 0
- 積分
- 200
- 點名
- 0
- 作業系統
- winxp
- 軟體版本
- officexp
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2010-7-31
- 最後登錄
- 2018-9-19
|
3#
發表於 2018-9-3 15:35
| 只看該作者
本帖最後由 mnsmrtl 於 2018-9-3 15:38 編輯
- Sub Ac抓警示()
- Call GetAlarm(1)
- End Sub
- Sub GetAlarm(Nd)
- Dim xRow%, xCode, xDate As Range, i, j, writeIn As Range
- Call A關閉
- xRow = Sheets("基本").[A1].End(xlDown).Row
- For i = 2 To xRow
- With Sheets("基本")
- xCode = .Cells(i, "A")
- Set writeIn = .Range(.Cells(i, "C"), .Cells(i, "T")) '型態高低 寫入資料範圍
- End With
- Set xDate = Sheets("收").Cells(1, 3).Offset(0, Nd - 1) '根據參數修改起始天數
- Call Pattern(writeIn, xCode, xDate)
- Next i
- Call A開啟
- End Sub
- Function grabData(Sht$, xCode, xDate As Range) '從資料庫抓取數據
- Dim matC, matD
- With Sheets(Sht)
- matC = WorksheetFunction.Match(xCode, .Columns(1), 0)
- matD = WorksheetFunction.Match(xDate, .Rows(1), 0)
- Set grabData = .Cells(matC, matD)
- End With
- End Function
- Function fbdate(Rng As Range) '按儲存格找「日期」
- Set fbdate = Sheets(Rng.Worksheet.Name).Cells(1, Rng.Column)
- End Function
- Sub Pattern(Rng As Range, xCode, xDate As Range)
- Dim H As Range, L As Range, C As Range, rh As Range, rl As Range
- Dim Tf1 As Boolean, Tf2 As Boolean
- Dim i, j, k, th, tl, sw
- Rng.ClearContents
- i = 0: j = 0: k = 0
- th = 0: tl = 0: sw = 0
- Do While i < 8 '取6個點
- Set H = grabData("高", xCode, xDate).Offset(0, j)
- Set L = grabData("低", xCode, xDate).Offset(0, j)
- Set C = grabData("收", xCode, xDate).Offset(0, j)
- If j > 300 Then Exit Do '限制資料庫範圍
- If C <> "" Then
- k = k + 1 '計數
- If k = 1 Then GoSub RefreshHL
- Tf1 = sw >= 0 And C < tl * 0.9
- Tf2 = sw <= 0 And C > th * 1.1
- If Tf1 Or Tf2 Then
- GoSub MoveAndSwitch
- GoSub WriteDataIn
- GoSub RefreshHL
- Else
- Set rh = IIf(H > rh, H, rh)
- Set rl = IIf(L < rl, L, rl)
- th = IIf(H < th, H, th)
- tl = IIf(L > tl, L, tl)
- GoSub WriteDataIn
- End If
- End If
- Debug.Print H.Column
- j = j + 1
- Loop
- Exit Sub
- MoveAndSwitch:
- i = i + 1
- sw = IIf(sw >= 0, -1, 1)
- Return
- WriteDataIn:
- If i < 7 And i > 0 Then
- Rng(i) = IIf(sw = 1, rh, rl)
- Rng(i + 6) = fbdate(IIf(sw = 1, rh, rl))
- Rng(i + 12) = k
- End If
- Return
- RefreshHL:
- Set rh = H
- Set rl = L
- th = H
- tl = L
- Return
- End Sub
對於變數J，在其他程序沒有做什麼動作
檔案內，是各股票的每日開盤四價及成交量
如圖
監看式的部分，我要再查一下資料，看怎麼用…謝謝樓上指點
上傳到MEGA空間了，大約15M，網址如下
https://mega.nz/#!uTZkGI4K!XtnUzYtIyzsHBFPNF4hGrcroUtzdO8UthkdFSorPVxk |
|
