- 帖子
- 2035
- 主題
- 24
- 精華
- 0
- 積分
- 2031
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office2010
- 閱讀權限
- 100
- 性別
- 男
- 註冊時間
- 2012-3-22
- 最後登錄
- 2024-2-1
|
101#
發表於 2016-4-10 16:23
| 只看該作者
本帖最後由 c_c_lai 於 2016-4-10 16:24 編輯
回復 98# 藍天麗池
 股票10A.rar (22.07 KB)
股票10B.rar (23.52 KB)
- Sub RecordPrice(TG As Range)
- Dim WR As Long, cts As Long
-
- With Sheets("RTD")
- If .Range("A1") < 1 Then Exit Sub
-
- cts = TG.Column
-
- WR = .Cells(Rows.Count, cts).End(xlUp).Row + 1 ' 求取該異動欄位的最後一筆紀錄列位置
-
- If WR = 3 Or .Cells(WR - 1, cts) <> .Cells(2, cts) Then
- .Cells(WR, cts).Offset(, -3).NumberFormatLocal = "hh:mm:ss" ' 設定儲存格格式 (時間)
-
- ' 修正為只寫入 『券商名』、『成交』、『總量』，「時間」則不予同步帶入
- ' .Cells(WR, cts).Offset(, -2).Resize(, 3) = .Range(TG.Address).Offset(, -2).Resize(, 3).Value
- .Cells(WR, cts).Offset(, -2).Resize(, 4) = .Range(TG.Address).Offset(, -2).Resize(, 4).Value
- End If
- End With
- End Sub
- Private Sub Worksheet_Calculate()
- Dim Rng As Range, E As Variant
-
- ' Sheets("RTD") 工作表上任何有公式儲存格值有變動,啟動 Sheets("RTD") 的 Worksheet_Calculate 事件
- On Error Resume Next ' 檔案開啟時 DEE傳回錯誤值
- Set Rng = UsedRange.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
-
- If Not Rng Is Nothing Then Exit Sub
- On Error GoTo 0 ' 開盤不再處理程式碼的錯誤
-
- For Each E In Me.Names
- If E.Name Like "*TotalVolume*" Then ' 總量的名稱
- If Range(E.Name) > 0 Then ' 總量 > 0
- With Cells(Rows.Count, Range(E.Name).Column).End(xlUp)
- ' 總量名稱所在的最底列往上到有資料的儲存格
- If .Row = 2 Or .Row > 2 And .Value <> Range(E.Name).Value Then ' (各股總量有變動)
- ' 修正為只寫入 『券商名』、『成交』、『總量』，「時間」則不予同步帶入
- ' .Offset(1).Cells(1, -1).Resize(, 3) = Range(E.Name).Cells(, -1).Resize(, 3).Value
- .Offset(1).Cells(1, -1).Resize(, 4) = Range(E.Name).Cells(, -1).Resize(, 4).Value
- End If
- End With
- End If
- End If
- Next
- End Sub
|
|
