1 ...567891011121314
返回列表 上一主題 發帖

價格紀錄的語法有寫錯嗎??

藍天麗池

帖子
365 
主題
40 
精華
0 
積分
406 
點名
0  
作業系統
Win 7 
軟體版本
OFFICE 2003 
閱讀權限
20 
註冊時間
2012-12-11 
最後登錄
2024-8-24 
81# 跳轉到 »
發表於 2016-4-10 07:47 | 只看該作者
回復 78# c_c_lai

上圖示股票10的測試結果，黑框的部分沒有往下複製，紅框的部分為一組(B2-E2、F2-I2...等等)，是總量變動後要往下紀錄的欄位

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
82#
發表於 2016-4-10 10:10 | 只看該作者
回復 81# 藍天麗池
明白了，有事出去一下 (買無糖豆漿)。
回頭再修正。

TOP

藍天麗池

帖子
365 
主題
40 
精華
0 
積分
406 
點名
0  
作業系統
Win 7 
軟體版本
OFFICE 2003 
閱讀權限
20 
註冊時間
2012-12-11 
最後登錄
2024-8-24 
83#
發表於 2016-4-10 11:45 | 只看該作者
回復 82# c_c_lai


    C大不急，你先忙

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
84#
發表於 2016-4-10 13:29 | 只看該作者
回復  c_c_lai

上圖示股票10的測試結果，黑框的部分沒有往下複製，紅框的部分為一組(B2-E2、F2-I2...等 ...
藍天麗池 發表於 2016-4-10 07:47

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
85#
發表於 2016-4-10 14:26 | 只看該作者
回復 84# c_c_lai
39帖  補上非營業時間不執行程式
  1. Private Sub Worksheet_Calculate()
  2.         Dim Rng As Range, E As Variant
  3.         On Error Resume Next ' 檔案開啟時 DEE傳回錯誤值
  4.         Set Rng = UsedRange.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
  5.         If Not Rng Is Nothing Then Exit Sub
  6.         On Error GoTo 0 '開盤不再處理程式碼的錯誤
  7.         If Time < #9:00:00 AM# Or Time > #1:31:00 PM# Then Exit Sub '非營業時間
  8.         For Each E In Me.Names
  9.             If E.Name Like "*TotalVolume*" Then   '總量的名稱
  10.                 If Range(E.Name) > 0 Then
  11.                     With Cells(Rows.Count, Range(E.Name).Column).End(xlUp)  ''總量名稱所在的最底列往上到有資料的儲存格
  12.                             If .Row = 2 Or .Row > 2 And .Value <> Range(E.Name).Value Then
  13.                                 .Offset(1).Cells(1, -2).Resize(, 4) = Range(E.Name).Cells(, -2).Resize(, 4).Value
  14.                             End If
  15.                     End With
  16.                 End If
  17.             End If
  18.         Next
  19. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
86#
發表於 2016-4-10 15:04 | 只看該作者
回復 83# 藍天麗池
回復 85# GBKEE
附上 股票10A.rar 以及 股票10B.rar 兩個檔案；
股票10A.rar 是我的 (Worksheet_Change()) 程式，
股票10B.rar 則是 GBKEE 大大的 (Worksheet_Calculate())
程式，且加入了 非開盤時間的考量。 A、B 是兩個
不同的程式模組，明天測試完畢向我倆報告心得結果。
股票10A.rar (21.88 KB)
股票10B.rar (23.44 KB)

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
87#
發表於 2016-4-10 15:09 | 只看該作者
回復 83# 藍天麗池
我的部分：
ThisWorkbook：
  1. Option Explicit

  3. Private Sub Workbook_Open()
  4.     '  Nothing to do (保留)
  5. End Sub
複製代碼
shtRTD(RTD)表單:
  1. Option Explicit

  3. Private Sub Worksheet_Change(ByVal Target As Range)
  4.     '  當 Target (總量) 欄位有異動時， 則去呼叫 RecordPrice 的方法 (Method)。
  5.    
  6.     If Target.Row = 2 And Target.Column Mod 4 = 0 Then
  7.         Call RecordPrice(Target)
  8.     End If
  9. End Sub
複製代碼
Module1:
  1. Option Explicit

  3. Sub RecordPrice(TG As Range)
  4.     Dim WR As Long, cts As Long
  5.    
  6.     With Sheets("RTD")
  7.         If .Range("A1") < 1 Then Exit Sub
  8.    
  9.         cts = TG.Column
  10.    
  11.         WR = .Cells(Rows.Count, cts).End(xlUp).Row + 1         '  求取該異動欄位的最後一筆紀錄列位置
  12.         
  13.         If WR = 3 Or .Cells(WR - 1, cts) <> .Cells(2, cts) Then
  14.             .Cells(WR, cts).Offset(, -3).NumberFormatLocal = "hh:mm:ss"   '  設定儲存格格式 (時間)
  15.             
  16.             .Cells(WR, cts).Offset(, -2).Resize(, 3) = .Range(TG.Address).Offset(, -2).Resize(, 3).Value
  17.         End If
  18.     End With
  19. End Sub

  21. Sub 時間()
  22.     Sheets("RTD").Cells(2, 1) = WorksheetFunction.Text(Now(), "hh:mm:ss")
  23.     Application.OnTime Now() + TimeValue("00:00：01"), "時間"
  24. End Sub

  26. Sub Cls()
  27.     With Sheets("RTD")
  28.         .Range("A3:OK5000").ClearContents
  29.         .[A3].Select
  30.     End With
  31. End Sub
複製代碼

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
88#
發表於 2016-4-10 15:13 | 只看該作者
本帖最後由 c_c_lai 於 2016-4-10 15:20 編輯

回復 83# 藍天麗池
.

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
89#
發表於 2016-4-10 15:19 | 只看該作者
本帖最後由 c_c_lai 於 2016-4-10 15:26 編輯

回復 83# 藍天麗池
.GBKEE 大大的程式一直貼不上
自行看程式吧！

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
90#
發表於 2016-4-10 15:24 | 只看該作者
回復 81# 藍天麗池
GBKEE 大大的程式：
ThisWorkbook：[code]Option Explicit

Private Sub Workbook_Open()
    Dim xRng As Range, First_Aaddres  As String, xRng_Name As String
    Dim nm As Variant
   
    Application.RTD.ThrottleInterval = 0
    Application.Calculation = xlCalculationAutomatic     '  自動重算
   
    '  清除「名稱管理員」內的所有內容
    For Each nm In ActiveWorkbook.Names
        nm.Delete
    Next nm
   
    With Sheets("RTD")
        '  檔案開啟時 定義了 Sheets("RTD") 所有總量 DDE 公式的儲存格
        Set xRng = .Rows(2).Cells.Find("TotalVolume", LookIn:=xlFormulas)
        
        If Not xRng Is Nothing Then
            First_Aaddres = xRng.Address
            
            Do
                xRng_Name = Split(xRng.Formula, "'")(1)
                xRng_Name = "TotalVolume" & Split(xRng_Name, ".")(0)
                .Names.Add xRng_Name, xRng       '  名稱定義: 所有總量的 DDE 公式的儲存格

TOP

        靜思自在 : 地上種了菜，就不易長草；心中有善，就不易生惡。
1 ...567891011121314
返回列表 上一主題