123456
返回列表 上一主題 發帖

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

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
31# 跳轉到 »
發表於 2016-4-10 06:04 | 顯示全部帖子
回復 73# 藍天麗池
在第三列 (含) 以下皆為空白，於任何總量之第二攔
不做任何修改按下 ENTER，你會看到第三欄自動將
第二攔的值複製 (未經修正時)。

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
32#
發表於 2016-4-10 06:47 | 顯示全部帖子
回復 76# GBKEE
我有留意到 "名稱定義" 的定義，
  1.   : First_Aaddres : "$D$2"                               : String
  2.   : xRng_Name     : "TotalVolume2330"                    : String
  3.   : xRng          : "XQTISC|Quote!'2330.TW-TotalVolume'" : Range/Range
  4.   .Names.Add xRng_Name, xRng       '  名稱定義: 所有總量的 DDE 公式的儲存格
複製代碼
以及
  1.   With Cells(Rows.Count, Range(E.Name).Column).End(xlUp)
  2.   '  總量名稱所在的最底列往上到有資料的儲存格
  3.       If .Row = 2 Or .Row > 2 And .Value <> Range(E.Name).Value Then       '  (各股總量有變動)
  4.       '  最底列往上有資料的儲存格 <> 總量的值
  5.           .Offset(1).Cells(1, -2).Resize(, 4) = Range(E.Name).Cells(, -2).Resize(, 4).Value
  6.       End If
  7.   End With
複製代碼
的作業處裡。
Good Idea!
謝謝囉！

TOP

c_c_lai

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

TOP

c_c_lai

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

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

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
35#
發表於 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 
36#
發表於 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 
37#
發表於 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 
38#
發表於 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 
39#
發表於 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

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
40#
發表於 2016-4-10 15:53 | 顯示全部帖子
回復 91# 藍天麗池
"空白" 不懂你的意思？能否永圖表畫個漫畫？

TOP

        靜思自在 : 虛空有盡．我願無窮，發願容易行願難。
123456
返回列表 上一主題