麻辣家族討論版版 - Powered by Discuz! Board

標題: 價格紀錄的語法有寫錯嗎?? [打印本頁]

作者: 藍天麗池 時間: 2016-3-17 23:18 標題: 價格紀錄的語法有寫錯嗎??

本帖最後由藍天麗池於 2016-3-17 23:24 編輯

[attach]23471[/attach]
請問版上大大，我上傳的附件是一個價格變動就記錄的VBA，但是我在執行附件裡面的Macro1時，應該資料會刪掉，可是執行完後不但不會刪掉，還會馬上出現很多一樣的資料，請版上大大幫我看看這個語法有甚麼問題嗎??

我發現把旁邊的公式刪掉就正常了，這是什麼原因??可以修改成價格變動就紀錄且同時保有旁邊的公式嗎??

DDE如果沒有可以用隨便的數字下去測試

作者: 准提部林 時間: 2016-3-18 09:54

http://forum.twbts.com/viewthread.php?tid=15062&highlight=

用 Worksheet_Calculate 事件！
是可以，但考慮層面較多，例如會產生〔連鎖觸動〕，要不是同一筆內容記錄成很多筆，
不然整個檔案就掛掉，您必須去控制事件發生的時機，在下載附檔中有個例子，可參考！

作者: 藍天麗池 時間: 2016-3-18 22:42

回復 2# 准提部林

大大謝謝你的好意，但我不會寫，只會簡單的修改，沒有範例就沒辦法了，不過還是謝謝你

作者: c_c_lai 時間: 2016-3-21 13:04

回復 1# 藍天麗池
改用 Change 試試看！

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then Call RecordPrice
End Sub

複製代碼

作者: 藍天麗池 時間: 2016-3-21 22:17

回復 4# c_c_lai
好，謝謝C大

作者: 藍天麗池 時間: 2016-3-21 23:00

回復 4# c_c_lai

C大請教一下這段程式碼要加在哪裡??

作者: c_c_lai 時間: 2016-3-22 06:48

本帖最後由 c_c_lai 於 2016-3-22 06:53 編輯

回復 6# 藍天麗池
取代你原先 Sheets("RTD") 裡的 Worksheet_Calculate()。
又，你目前 "模組1" RecordPrice 裡的 For ~ Next 運算式可以
用下列方式取代，以節省處裡時間：

' For I = 1 To 3
' Cells(WR, I) = Cells(2, I)
' Next I
Cells(WR, 1).Resize(, 3) = [A2:C2].Value

複製代碼

作者: 藍天麗池 時間: 2016-3-22 08:26

本帖最後由藍天麗池於 2016-3-22 08:32 編輯

回復 7# c_c_lai

[attach]23517[/attach][attach]23518[/attach]
1. C大我不太懂，為什麼多了Cells(WR, 1).Resize(, 3) = [A2:C2].Value這一行程式碼執行數度會加快??

2.另外再請教你一個問題，如果目前是將A2-C2的資料往下寫，改成把資料放在C2-E2然後往下寫要怎麼改程式碼??
就是將圖一改成圖二，上圖不是改好的，是我用拉的

3.以下是J大寫的，請教C大用Excel.Application.EnableEvents 跟你的用change哪種比較快??
Excel.Application.EnableEvents = 0
WR = Range("A1").End(xlDown).Row + 1
'ActiveWindow.ScrollRow = WR - 5 '只顯示最新幾筆資料
If (WR = 3) Or _
(Range("B" & WR - 1) <> Range("B2")) Then '總量有異動時才記錄
For I = 1 To 3
Cells(WR, I) = Cells(2, I)
Next
End If
Excel.Application.EnableEvents = 1

作者: c_c_lai 時間: 2016-3-22 12:04

回復 8# 藍天麗池
先回答你第一個問題：

If (WR = 3) Or _
(Range("B" & WR - 1) <> Range("B2")) Then ' 總量有異動時才記錄
For I = 1 To 3
Cells(WR, I) = Cells(2, I)
Next
End If

複製代碼

從 For ~ Next 改為下列一次功夫就填入值 (Assign Value) 的方式，
你說是哪個處理較快速？

If (WR = 3) Or _
(Range("B" & WR - 1) <> Range("B2")) Then ' 總量有異動時才記錄
Cells(WR, 1).Resize(, 3) = [A2:C2].Value
End If

複製代碼

作者: 藍天麗池 時間: 2016-3-22 12:10

回復 9# c_c_lai

C大我會錯意了，剛剛沒看到你前面有 '，把程式mark掉所以我才覺得奇怪，看到後就沒問題了

作者: c_c_lai 時間: 2016-3-22 13:15

本帖最後由 c_c_lai 於 2016-3-22 13:17 編輯

回復 8# 藍天麗池
Sheets - shtRTD (RTD)
原本內容：

Option Explicit
Private Sub Worksheet_Calculate()
Call RecordPrice
End Sub

複製代碼

將它移除掉，修改為：

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' 當 B2 欄位有異動時，則去呼叫 RecordPrice 的方法 (Method)。
If Target.Address = "$B$2" Then Call RecordPrice
End Sub

複製代碼

假設：
如你欲將原本之：

A B C D
時間總量
22:38:54 8734.54 2238 8734.54

複製代碼

更改為從 D 欄開始重新佈局成：

C D E F
時間總量
22:38:54 8734.54 2238 8734.54

複製代碼

則將上述之 Worksheet_Change 請修正為：

Private Sub Worksheet_Change(ByVal Target As Range)
' 當 D2 欄位有異動時，則去呼叫 RecordPrice 的方法 (Method)。
If Target.Address = "$D$2" Then Call RecordPrice
End Sub

複製代碼

另外， Module1 內之 RecordPrice 裡的模組：

Option Explicit
Sub RecordPrice()
Dim WR As Long
If Range("D2") < 1 Then Exit Sub
WR = Range("A1").End(xlDown).Row + 1
' ActiveWindow.ScrollRow = WR - 5 ' 只顯示最新幾筆資料
If (WR = 3) Or _
(Range("B" & WR - 1) <> Range("B2")) Then ' 總量有異動時才記錄
Cells(WR, 1).Resize(, 3) = [A2:C2].Value
End If
End Sub

複製代碼

更換為：

Option Explicit
Sub RecordPrice()
Dim WR As Long
If Range("F2") < 1 Then Exit Sub
WR = Range("C1").End(xlDown).Row + 1
' ActiveWindow.ScrollRow = WR - 5 ' 只顯示最新幾筆資料
If (WR = 3) Or _
(Range("D" & WR - 1) <> Range("D2")) Then ' 總量有異動時才記錄
Cells(WR, 3).Resize(, 3) = [C2:E2].Value
End If
End Sub

複製代碼

作者: 藍天麗池 時間: 2016-4-7 22:45

本帖最後由藍天麗池於 2016-4-7 22:50 編輯

回復 11# c_c_lai

[attach]23750[/attach]
[attach]23751[/attach]
C大再請教你一下，我之前的程式碼是設定為某一個值變動就紀錄，那想請教一下C大如果我的變動值變多個的化程式碼要如何更改??

例:如圖所示，如果C2變動就往下紀錄B2-C2，但是其他不紀錄，下個時間C2沒變動換E2變動，則記錄D2-E2，一樣其他不紀錄，以此類推，我的變動值原本只有設定If (WR = 3) Or _ (Range("C" & WR - 1) <> Range("C2")) Then '總量有異動時才記錄，我現在要設定多個，所有量的部分都設定為變動就紀錄，要如何更改程式碼呢??

作者: c_c_lai 時間: 2016-4-8 08:49

回復 12# 藍天麗池
不太明瞭 "如果C2變動就往下紀錄B2-C2，但是其他不紀錄"，是甚麼意思？
你的 RecordPrice() 一次便寫入 A:U 啊。何謂 "其他不紀錄" ？

作者: 藍天麗池 時間: 2016-4-8 09:35

回復 13# c_c_lai

C大，因為每支股票的成交時間不太一樣，所以要分開寫入，不然計算上會有重疊

假設台積電9:01分有成交，其他沒成交，如果全部往下寫入，其他的沒成交也會寫入，這樣造成每支股票的成交量在計算上會重複，而且如果分開寫入資料量也互比較少不是嗎??

作者: c_c_lai 時間: 2016-4-8 09:57

回復 14# 藍天麗池
是這樣嗎？
[attach]23757[/attach]

作者: 藍天麗池 時間: 2016-4-8 10:12

本帖最後由藍天麗池於 2016-4-8 10:15 編輯

回復 15# c_c_lai

C大，沒錯，但是可以讓中間的空格不見，也就是說資料是連續的，以台積電來說上圖示出現在B10-C11，讓資料連續，出現在B8-C9，這樣可以嗎??

作者: c_c_lai 時間: 2016-4-8 10:22

回復 16# 藍天麗池
那[A] 時間豈不被後者敷蓋？

作者: c_c_lai 時間: 2016-4-8 10:28

回復 16# 藍天麗池
Like this?
[attach]23759[/attach]

作者: 藍天麗池 時間: 2016-4-8 10:33

回復 17# c_c_lai
[attach]23760[/attach]

我是打算之後多一欄來寫入時間，讓每個時間都分開，C大怎麼看??

作者: 藍天麗池 時間: 2016-4-8 10:34

回復 18# c_c_lai

對

作者: 藍天麗池 時間: 2016-4-8 10:36

回復 18# c_c_lai

因為我到時候可能會抓100支股票，怕資料量太大電腦跑不動，所以才要盡可能減少不必要的資料

作者: c_c_lai 時間: 2016-4-8 10:42

回復 20# 藍天麗池
shtRTD(RTD) 工作表單內容：

Private Sub Worksheet_Change(ByVal Target As Range)
' 當 D2 欄位有異動時，則去呼叫 RecordPrice 的方法 (Method)。
If Target.Address = "$C$2" Or Target.Address = "$E$2" Or Target.Address = "$G$2" Or Target.Address = "$I$2" Or _
Target.Address = "$K$2" Or Target.Address = "$M$2" Or Target.Address = "$O$2" Or _
Target.Address = "$Q$2" Or Target.Address = "$S$2" Or Target.Address = "$U$2" Then
Call RecordPrice(Target.Address)
End If
End Sub

複製代碼

Module1 模組內容：

Option Explicit
Sub RecordPrice(TG As String)
Dim WR As Long
If Range("A1") < 1 Then Exit Sub
' WR = Range("A1").End(xlDown).Row + 1
WR = Range(TG).End(xlDown).Row + 1 ' 修改成以觸發之欄位為判斷基點
' ActiveWindow.ScrollRow = WR - 5 ' 只顯示最新幾筆資料
Cells(WR, 1).NumberFormatLocal = "hh:mm:ss"
If WR = 3 Then ' 總量有異動時才記錄
Cells(WR, 1).Resize(, 21) = [A2:U2].Value
Else
Cells(WR, 1) = [A2]
Range(Left(TG, 3) & WR) = Range(TG)
Range(Left(TG, 3) & WR).Offset(, -1) = Range(TG).Offset(, -1)
End If
End Sub

複製代碼

作者: 藍天麗池 時間: 2016-4-8 10:45

回復 22# c_c_lai

Private Sub Worksheet_Change(ByVal Target As Range)

'  當 D2 欄位有異動時，則去呼叫 RecordPrice 的方法 (Method)。

If Target.Address = "$C$2" Or Target.Address = "$E$2" Or Target.Address = "$G$2" Or Target.Address = "$I$2" Or _

            Target.Address = "$K$2" Or Target.Address = "$M$2" Or Target.Address = "$O$2" Or _

            Target.Address = "$Q$2" Or Target.Address = "$S$2" Or Target.Address = "$U$2" Then

      Call RecordPrice(Target.Address)

End If

End Sub

C大以上的地方如果我有100檔股票，是要打100個嗎??:'(

作者: c_c_lai 時間: 2016-4-8 10:52

回復 21# 藍天麗池
標頭第一、二列公式請自行補上 (因我此端無啟動券商軟體，所以無法加入公式會照成Excel檔案 "無法回應")
[attach]23761[/attach]
至於如何處裡日期問題，你再自行先研究看看。

作者: c_c_lai 時間: 2016-4-8 10:57

回復 23# 藍天麗池
如你不去特別指定欄位的觸發的話，那只要任何欄位有異動均會觸發事件的。

作者: 藍天麗池 時間: 2016-4-8 11:00

回復 25# c_c_lai
測試後沒有任何反應

作者: c_c_lai 時間: 2016-4-8 11:13

回復 26# 藍天麗池
你是指 "股票0.xlsm" 嗎？
麗二列的圈商商品的對應公式有加入嗎？

作者: 藍天麗池 時間: 2016-4-8 11:48

本帖最後由藍天麗池於 2016-4-8 11:49 編輯

回復 27# c_c_lai

有阿，但是沒有任何反應
對，你剛剛給我的股票0我把公式放進去後沒有反應

作者: c_c_lai 時間: 2016-4-8 11:56

回復 28# 藍天麗池
第二列的任何總量有異動時，均未有寫入資料嗎？
你是用完整的 "股票0.xlsm" 來測試的嗎？
如仍一樣，上傳你目前正在測試的檔案。
否則我附上的圖示是如何產生的？

作者: c_c_lai 時間: 2016-4-8 11:59

回復 28# 藍天麗池
[attach]23762[/attach]

作者: 藍天麗池 時間: 2016-4-8 12:16

回復 30# c_c_lai

C大我是用你的檔案，然後把第二列公式代入，測試結果沒有反應，我現在出門了，我回家後會將檔案上傳
測試結果是總量一直有變動，但程式都沒動作

作者: c_c_lai 時間: 2016-4-8 12:30

回復 31# 藍天麗池
我順手寫了一隻測試程式，你將它放入至 Module1 內執行看是否有增加寫入列，
如果沒有這才叫靈異。

Sub Test()
Dim cts As Integer
For cts = 3 To 13 Step 2
Cells(2, cts) = Cells(2, cts) + 1
Next cts
End Sub

複製代碼

作者: 藍天麗池 時間: 2016-4-8 12:52

本帖最後由藍天麗池於 2016-4-8 12:54 編輯

回復 32# c_c_lai

C大謝謝，我回家後測試，但剛剛那個檔案為什麼會沒動作？
我全部的程式都沒有動，只把第二列的公式代入而已啊，怎麼會這樣？

上述增加的程式用意是測試有沒有增加列嗎？那跟原本的程式有關係嗎？

作者: c_c_lai 時間: 2016-4-8 13:23

回復 33# 藍天麗池
[attach]23763[/attach]

作者: c_c_lai 時間: 2016-4-8 13:34

回復 33# 藍天麗池
[attach]23764[/attach]

作者: 藍天麗池 時間: 2016-4-8 22:25

本帖最後由藍天麗池於 2016-4-8 22:26 編輯

回復 35# c_c_lai

[attach]23767[/attach]
C大，全部都沒錯唷，我是用你的檔案，所以完全沒改，我上傳你看看
打開之後沒有任何動作，甚至我手動去更改量，還會出現錯誤

作者: 藍天麗池 時間: 2016-4-8 23:46

回復 35# c_c_lai

[attach]23768[/attach]
C大附件是最終版本，此版本不用複製時間，只要往下寫B2-E2、F2-I2...以此類推，我不知道如果這樣的話以下要如何更改

Private Sub Worksheet_Change(ByVal Target As Range)
'  當 D2 欄位有異動時，則去呼叫 RecordPrice 的方法 (Method)。
If Target.Address = "$D$2" Or Target.Address = "$H$2" Or Target.Address = "$L$2" Or Target.Address = "$P$2" Or _
            Target.Address = "$T$2" Or Target.Address = "$X$2" Or Target.Address = "$AB$2" Or _
            Target.Address = "$AF$2" Or Target.Address = "$AJ$2" Or Target.Address = "$AN$2" Then
      Call RecordPrice(Target.Address)
End If
End Sub

真的要打100個嗎??

作者: c_c_lai 時間: 2016-4-9 06:25

回復 36# 藍天麗池
請先把你那端整個測試的程序結果詳細地描述一下，
包含券商軟體的啟動，以及是否在開盤期間運作？
並把執行後的畫面 (一分鐘前後的執行的畫面)
Hard Copy 出來上傳，我想瞭解這之前你的舊有程式
是如何執行OK的。因為程式結構未變，變動的僅僅是
邏輯判斷不同而已，在我端無論新舊均能正常運作，
為何你那端就不行？

作者: GBKEE 時間: 2016-4-9 08:08

本帖最後由 GBKEE 於 2016-4-10 14:28 編輯

回復 37# 藍天麗池

Option Explicit
Private Sub Workbook_Open()
Dim xRng As Range, First_Aaddres As String, xRng_Name As String
Application.Calculation = xlCalculationAutomatic
With Sheets("RTD")
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 ''名稱定義:所有總量的Dee公式的儲存格
Set xRng = .Rows(2).Cells.FindNext(xRng)
Loop Until xRng.Address = First_Aaddres
End If
End With
End Sub

複製代碼

重算事件試試看

Option Explicit
Private Sub Worksheet_Calculate()
Dim Rng As Range, E As Variant
On Error Resume Next ' 檔案開啟時 DEE傳回錯誤值
Set Rng = UsedRange.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
If Not Rng Is Nothing Then Exit Sub
On Error GoTo 0 '開盤不再處理程式碼的錯誤
If Time < #9:00:00 AM# Or Time > #1:31:00 PM# Then Exit Sub '非營業時間
For Each E In Me.Names
If E.Name Like "*TotalVolume*" Then '總量的名稱
If Range(E.Name) > 0 Then
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, -2).Resize(, 4) = Range(E.Name).Cells(, -2).Resize(, 4).Value
End If
End With
End If
End If
Next
End Sub

複製代碼

作者: 藍天麗池 時間: 2016-4-9 08:32

回復 38# c_c_lai

C大，這樣說好了，你一開始傳給我的股票0我用手動更改是可以執行的，所以我就把原本那份套入公式，之後就不能執行，我"完全"沒有變更，所以我在想之前那份可以執行是因為"純數字"，後來帶入公式後無法執行，會不會是因為程式對公式的判斷出現問題??

因為原本用數字可以執行，帶入公式後就不行，所以我認為問題不會出現在券商的軟體，因為如果問題出現在軟體，那一開始的股票0就也會無法執行阿，但純數字版的卻可以執行，以上是我得看法，C大認為呢??

作者: 藍天麗池 時間: 2016-4-9 08:37

回復 39# GBKEE

G大好久不見了，之前聽你說眼睛不舒服，還以為你比較少上線了

G大請問一下這個是要放在哪裡?? Sheet or module ??
這個是新的版本，還是針對C大的修改的呢??

作者: GBKEE 時間: 2016-4-9 08:44

本帖最後由 GBKEE 於 2016-4-9 08:46 編輯

回復 41# 藍天麗池
37帖的檔案
ThisWorkbook

Private Sub Workbook_Open()

複製代碼

Sheet

Private Sub Worksheet_Calculate()

複製代碼

是啊,螢幕看久眼睛會痛,上線的時間需控制一下.

作者: 藍天麗池 時間: 2016-4-9 08:46

回復 42# GBKEE

我了解了，我試試看

作者: 藍天麗池 時間: 2016-4-9 08:52

回復 42# GBKEE

G大妳的版本會全部往下寫，而不是有變動才往下寫，是這樣嗎??
而且我手動更改也不會繼續往下寫

作者: c_c_lai 時間: 2016-4-9 08:55

本帖最後由 c_c_lai 於 2016-4-9 08:57 編輯

回復 40# 藍天麗池
終於追蹤到問題點了：
請修改 RecordPrice 的 WR 判斷

' WR = Range(TG).End(xlDown).Row + 1 ' 修改成以觸發之欄位為判斷基點 (WR=1048577 ?)
' 當資料列僅有兩列時，如從第二列作為判斷，則 WR 的結果值為 1048577，而非正確值 3
' 故將 End(xlDown) 修正為 End(xlUp)，如此始能正確無誤地取得正確值 3
' 設若對應值內容已存在有三列、或以上者，無論是使用 xlDown 或 xlUp 均無差異，皆能正確取值。
WR = Range(Left(TG, Len(TG) - 1) & Rows.Count).End(xlUp).Row + 1

複製代碼

因為我都是在超過第三列德情況下執行，沒留意到你原始的 xlDown 語法，所以會照成無法執行。
第 1048577 列 ??????， Oh My God!
抱歉！

作者: 藍天麗池 時間: 2016-4-9 08:59

回復 45# c_c_lai

別這樣說，C大真是辛苦你了，假日這麼早就起床幫我解決問題，萬分感謝

作者: 藍天麗池 時間: 2016-4-9 09:02

回復 45# c_c_lai

可是C大，我#37的那個要怎麼修改??真的要打100個??

作者: 藍天麗池 時間: 2016-4-9 09:04

回復 45# c_c_lai

修改之後，第一次變動會全部往下寫，為什麼會這樣??

作者: GBKEE 時間: 2016-4-9 09:12

本帖最後由 GBKEE 於 2016-4-9 09:14 編輯

回復 44# 藍天麗池
今天沒營業,請問測試方式

再解釋一下,程式的邏輯
檔案開啟時定義了Sheets("RTD")所有總量Dee公式的儲存格

Private Sub Workbook_Open()
With Sheets("RTD")
'''
.Names.Add xRng_Name, xRng ''名稱定義:Sheets("RTD")所有各股總量Dee公式的儲存格
'''

複製代碼

Sheets("RTD")工作表上任何有公式儲存格值有變動,啟動Sheets("RTD")的Worksheet_Calculate事件

Private Sub Worksheet_Calculate()
Dim Rng As Range, E As Variant
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, -2).Resize(, 4) = Range(E.Name).Cells(, -2).Resize(, 4).Value
'******************************************
End If
End With
End If
End If
Next
End Sub

複製代碼

作者: c_c_lai 時間: 2016-4-9 09:14

回復 47# 藍天麗池
100 當然都有其它各自對應的 100 『時間股票名稱成交總量』，
事前標題設定工作是無法全由電腦來處理個別之 DDE 匯入公式的。
泰國人有句名言「在尖尖」，意思是「慢慢來」，我正在思考來
輕鬆處理它。

作者: 藍天麗池 時間: 2016-4-9 09:15

本帖最後由藍天麗池於 2016-4-9 09:18 編輯

回復 49# GBKEE

我測試的方式是直接手動輸入量，還是說手動輸入的方式會不準確??

作者: 藍天麗池 時間: 2016-4-9 09:17

回復 50# c_c_lai

C大，你先忙，我的不急，你肯幫我就感謝不及了，所以你忙完你的事再幫我也不遲，謝謝

作者: c_c_lai 時間: 2016-4-9 09:18

回復 c_c_lai

修改之後，第一次變動會全部往下寫，為什麼會這樣??
藍天麗池發表於 2016-4-9 09:04

你不是第一次 (WR = 3) 就要全部寫入？

作者: 藍天麗池 時間: 2016-4-9 09:23

回復 53# c_c_lai

沒有，全部都是有變動才寫入，那個是之前別人幫我寫的，可以拿掉，直接刪除就好嗎??

作者: c_c_lai 時間: 2016-4-9 09:31

回復 54# 藍天麗池
替換掉

' If WR = 3 Then ' 總量有異動時才記錄
' Cells(WR, 1).Resize(, 400) = [A2:OJ2].Value
' Else
Range(Left(TG, Len(TG) - 1) & WR) = Range(TG) ' 可處裡到 AA 以後的欄位
' Range(Left(TG, 3) & WR) = Range(TG) ' 只能處裡到 A ~ Z
Range(Left(TG, Len(TG) - 1) & WR).Offset(, -1) = Range(TG).Offset(, -1) ' 可處裡到 AA 以後的欄位
' Range(Left(TG, 3) & WR).Offset(, -1) = Range(TG).Offset(, -1) ' 只能處裡到 A ~ Z
' End If

複製代碼

可處裡到 AA 以後的欄位，這是已開始動工的前置準備。

作者: 藍天麗池 時間: 2016-4-9 09:34

回復 55# c_c_lai

所以替換後變成下面這樣??

Sub RecordPrice(TG As String)
Dim WR As Long

If Range("A1") < 1 Then Exit Sub
'  WR = Range("A1").End(xlDown).Row + 1
WR = Range(TG).End(xlDown).Row + 1          '  修改成以觸發之欄位為判斷基點

'  ActiveWindow.ScrollRow = WR - 5          '  只顯示最新幾筆資料

Cells(WR, 1).NumberFormatLocal = "hh:mm:ss"

Range(Left(TG, Len(TG) - 1) & WR) = Range(TG)
Range(Left(TG, Len(TG) - 1) & WR).Offset(, -1) = Range(TG).Offset(, -1)
End If
End Sub

作者: c_c_lai 時間: 2016-4-9 09:40

倒數第五列加上
Cells(WR, 1) = [A2]
可能在測試時不小心刪掉了。

作者: 藍天麗池 時間: 2016-4-9 09:44

回復 57# c_c_lai

C大，那個是我故意刪掉的，因為時間會覆蓋，所以我在#37裡面有用其他方式取代了，這樣應該可以吧??

作者: c_c_lai 時間: 2016-4-9 09:45

回復 56# 藍天麗池
養成寫程式隨手加上註解說明，人不是神仙
過陣子你就會看不懂你自已以往寫的程式了，
如果都無註釋的話，絕不要偷懶自我要求。

作者: 藍天麗池 時間: 2016-4-9 09:48

回復 59# c_c_lai

好，C大我了解，謝謝
#37再麻煩你多份心了

作者: GBKEE 時間: 2016-4-9 10:03

本帖最後由 GBKEE 於 2016-4-9 10:05 編輯

回復 51# 藍天麗池
須先改為自動重算

Private Sub Workbook_Open()
Dim xRng As Range, First_Aaddres As String, xRng_Name As String
Application.RTD.ThrottleInterval = 0
Application.Calculation = xlCalculationAutomatic '自動重算
With Sheets("RTD")
Set xRng = .Rows(2).Cells.Find("TotalVolume", LookIn:=xlFormulas)
If Not xRng Is Nothing Then
'
'

複製代碼

Sub Ex()
Dim i As Integer
With Sheets("RTD")
.Range("a" & Rows.Count) = "=a1" '啟動第一次 Worksheet_Calculate
i = 1
For i = 1 To i * 4 * 8 Step 2
With .Cells(Rows.Count, 4 * i).End(xlUp).Offset(1)
.Value = Int((500 - 100 + 1) * Rnd + 100)
'總量名稱所在的最底列往上到有資料的儲存格給亂數
''因沒營業DEE不會變動,所以給個亂數
'等同DEE總量有變動
End With
.[a1] = i ' 公式值再度變動啟動 Worksheet_Calculate
Next
End With
End Sub

複製代碼

作者: 藍天麗池 時間: 2016-4-9 10:39

回復 61# GBKEE

G大，我更改後手動輸入還是沒動作

作者: GBKEE 時間: 2016-4-9 10:48

回復 62# 藍天麗池
有設為自動重算嗎?

Applicaion.Calculation = xlCalculationAutomatic '自動重算

複製代碼

手動是執行所給的Ex程式嗎?

作者: 藍天麗池 時間: 2016-4-9 12:11

回復 63# GBKEE

有改，手動是改成交量，不是執行程式，他不會自動執行嗎？

作者: c_c_lai 時間: 2016-4-9 12:52

回復 60# 藍天麗池
股票10：

shtRTD(RTD) 工作表單內容：

Private Sub Worksheet_Change(ByVal Target As Range)
' 當 Target (總量) 欄位有異動時，則去呼叫 RecordPrice 的方法 (Method)。
If Target.Row = 2 And Target.Column Mod 4 = 0 Then
Call RecordPrice(Target.Address)
End If
End Sub

複製代碼

Module1 模組內容：

Sub RecordPrice(TG As String)
Dim WR As Long
If Range("A1") < 1 Then Exit Sub
' ActiveWindow.ScrollRow = WR - 5 ' 只顯示最新幾筆資料
WR = Range(Left(TG, Len(TG) - 1) & Rows.Count).End(xlUp).Row + 1 ' 求取該異動欄位的最後一筆紀錄列位置
Range(Left(TG, Len(TG) - 1) & WR).Offset(, -3).NumberFormatLocal = "hh:mm:ss" ' 設定儲存格格式 (時間)
Range(Left(TG, Len(TG) - 1) & WR) = Range(TG) ' 可處裡到 AA 以後的欄位 (總量)
Range(Left(TG, Len(TG) - 1) & WR).Offset(, -1) = Range(TG).Offset(, -1) ' 可處裡到 AA 以後的欄位 (成交)
Range(Left(TG, Len(TG) - 1) & WR).Offset(, -3) = Range(TG).Offset(, -3) ' 寫入異價時間 (時間)
End Sub
Sub 時間()
Dim i As Integer
For i = 1 To 400 Step 4
Cells(2, i) = WorksheetFunction.Text(Now(), "hh:mm:ss")
Next i
Application.OnTime Now() + TimeValue("00:00：01"), "時間"
End Sub
Sub Cls()
Range("A3:OK5000").ClearContents
Range("A3").Select
End Sub

複製代碼

作者: c_c_lai 時間: 2016-4-9 12:59

回復 60# 藍天麗池
[attach]23774[/attach]

作者: c_c_lai 時間: 2016-4-9 13:55

回復 60# 藍天麗池
我覺得當 WR 等於 3 時，應加入判斷，否則在後續處裡會有瑕玼：

If WR = 3 Or Range(Left(TG, Len(TG) - 1) & WR - 1) <> Range(TG) Then
Range(Left(TG, Len(TG) - 1) & WR).Offset(, -3).NumberFormatLocal = "hh:mm:ss" ' 設定儲存格格式 (時間)
Range(Left(TG, Len(TG) - 1) & WR) = Range(TG) ' 可處裡到 AA 以後的欄位 (總量)
Range(Left(TG, Len(TG) - 1) & WR).Offset(, -1) = Range(TG).Offset(, -1) ' 可處裡到 AA 以後的欄位 (成交)
Range(Left(TG, Len(TG) - 1) & WR).Offset(, -3) = Range(TG).Offset(, -3) ' 寫入異價時間 (時間)
End If

複製代碼

作者: GBKEE 時間: 2016-4-9 14:09

回復 67# c_c_lai
DEE公式值的變動,儲存格內公式參照其他工作表,計算後值的改變.
不會觸發 Private Sub Worksheet_Change(ByVal Target As Range)事件程式

回復 64# 藍天麗池
手動是改成交量,需是 (DEE公式或儲存格內公式 ) 值的改變
1 請複製39帖的 Private Sub Workbook_Open() 到ThisWorkbook模組後執行一次
2 請複製39帖的Private Sub Worksheet_Calculate() 到Sheets("RTD") 模組
3請在 Sheets("RTD")上有DEE總量公式的 D2,H2,,, 輸入公式=工作表2!A1
4請在工作表2!A1輸入>0的任意數值
5看看 Sheets("RTD")的變動

作者: c_c_lai 時間: 2016-4-9 15:31

回復 68# GBKEE
我從未使用過 Private Sub Worksheet_Calculate()
它是怎麼運作？
DDE 匯入值變動時不會觸發 Worksheet_Change 嗎？
我是沒實際觀測過，因為平常我也不太使用它。之前
我比較偏向應用軟體分析與運作方面，謝謝您告知！

作者: c_c_lai 時間: 2016-4-9 15:42

回復 68# GBKEE
假設 DDE 的匯入值異動不會觸發 _Change() 的話：
為了要解決此案例，我會增加第三列作為觸動列，
即第三列每欄內容為 A3 (=A2)， B3 (=B2)， C3 (=C2)，. . . . .
如此便能觸發事件了。
寫入之資料則改從第四列開始判斷寫入。

作者: GBKEE 時間: 2016-4-9 19:03

本帖最後由 GBKEE 於 2016-4-9 19:05 編輯

回復 70# c_c_lai
即第三列每欄內容為 A3 (=A2)， B3 (=B2)， C3 (=C2)，. . . . .如此便能觸發事件了。

[attach]23780[/attach] 還是不行...

作者: c_c_lai 時間: 2016-4-9 20:03

回復 71# GBKEE
如果只用 Worksheet_Calculate() 的話，
那要如何判斷是哪個欄位觸發呢？
譬如需判斷 B1 、D1、F1、H1、J1 等欄位之
內容值有否異動，如此才能針對該欄位做相對應之處理？
謝謝！

作者: 藍天麗池 時間: 2016-4-9 22:22

本帖最後由藍天麗池於 2016-4-9 22:24 編輯

回復 67# c_c_lai

所以C大加入WR 等於 3 (#67)是最新的版本嗎??
如果不加入又會有什麼問題??

作者: 藍天麗池 時間: 2016-4-9 22:43

回復 65# c_c_lai

C大，可以幫我把時間拿掉嗎??時間的部分我已經想好要怎麼弄了，目前A欄時間不往下複製，B2-E2為一組往下複製，F2-I2一組依此類推，不是A2-D2為一組喔，可能誤會了，時間部份可以都拿掉，只留以下的部分，感謝，我的E2、I2、M2...為時間的輔助欄所以時間部份就不用了

Sub 時間()
[A2] = WorksheetFunction.Text(Now(), "hh:mm:ss")
Application.OnTime Now() + TimeValue("00:00：01"), "時間"
End Sub

作者: 藍天麗池 時間: 2016-4-9 22:47

回復 63# GBKEE

[attach]23783[/attach]

G大大你的程式執行起來有點怪，我截圖你看看，這是執行一次的結果

作者: GBKEE 時間: 2016-4-10 05:32

回復 72# c_c_lai
Worksheet_Calculate() 是無法判斷哪個儲存格觸發的.
39 帖的Private Sub Workbook_Open()
中有.Names.Add xRng_Name, xRng  ''名稱定義:所有總量的Dee公式的儲存格
當Worksheet_Calculate重算事件執行時
  For Each E In Me.Names 去判斷總量有變動,則記錄下來.

回復 75# 藍天麗池
這測試是正確的,沒營業DEE不會變動,總量的下方列位測試給值,假裝總量有變動

當Worksheet_Calculate重算事件執行時
  For Each E In Me.Names  去判斷總量有變動,則記錄下來.

星期一營業前打開檔案試試看

作者: c_c_lai 時間: 2016-4-10 06:04

回復 73# 藍天麗池
在第三列 (含) 以下皆為空白，於任何總量之第二攔
不做任何修改按下 ENTER，你會看到第三欄自動將
第二攔的值複製 (未經修正時)。

作者: c_c_lai 時間: 2016-4-10 06:47

回復 76# GBKEE
我有留意到 "名稱定義" 的定義，

: First_Aaddres : "$D$2" : String
: xRng_Name : "TotalVolume2330" : String
: xRng : "XQTISC|Quote!'2330.TW-TotalVolume'" : Range/Range
.Names.Add xRng_Name, xRng ' 名稱定義: 所有總量的 DDE 公式的儲存格

複製代碼

以及

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, -2).Resize(, 4) = Range(E.Name).Cells(, -2).Resize(, 4).Value
End If
End With

複製代碼

的作業處裡。
Good Idea!
謝謝囉！

作者: 藍天麗池 時間: 2016-4-10 07:19

本帖最後由藍天麗池於 2016-4-10 07:21 編輯

回復 76# GBKEE

可是我只有手動變更台積電的總量，為什麼其他的也會往下寫??
不是應該只又台積電會往下寫嗎??

作者: 藍天麗池 時間: 2016-4-10 07:25

回復 77# c_c_lai

C大，早阿，這麼早就起床動腦筋，辛苦了
74#在麻煩你修改一下，我等等來測試

作者: 藍天麗池 時間: 2016-4-10 07:47

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

作者: c_c_lai 時間: 2016-4-10 10:10

回復 81# 藍天麗池
明白了，有事出去一下 (買無糖豆漿)。
回頭再修正。

作者: 藍天麗池 時間: 2016-4-10 11:45

回復 82# c_c_lai

C大不急，你先忙

作者: c_c_lai 時間: 2016-4-10 13:29

回復 c_c_lai

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

[attach]23785[/attach]

作者: GBKEE 時間: 2016-4-10 14:26

回復 84# c_c_lai
39帖補上非營業時間不執行程式

Private Sub Worksheet_Calculate()
Dim Rng As Range, E As Variant
On Error Resume Next ' 檔案開啟時 DEE傳回錯誤值
Set Rng = UsedRange.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
If Not Rng Is Nothing Then Exit Sub
On Error GoTo 0 '開盤不再處理程式碼的錯誤
If Time < #9:00:00 AM# Or Time > #1:31:00 PM# Then Exit Sub '非營業時間
For Each E In Me.Names
If E.Name Like "*TotalVolume*" Then '總量的名稱
If Range(E.Name) > 0 Then
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, -2).Resize(, 4) = Range(E.Name).Cells(, -2).Resize(, 4).Value
End If
End With
End If
End If
Next
End Sub

複製代碼

作者: c_c_lai 時間: 2016-4-10 15:04

回復 83# 藍天麗池
回復 85# GBKEE
附上股票10A.rar 以及股票10B.rar 兩個檔案；
股票10A.rar 是我的 (Worksheet_Change()) 程式，
股票10B.rar 則是 GBKEE 大大的 (Worksheet_Calculate())
程式，且加入了非開盤時間的考量。 A、B 是兩個
不同的程式模組，明天測試完畢向我倆報告心得結果。
[attach]23786[/attach]
[attach]23787[/attach]

作者: c_c_lai 時間: 2016-4-10 15:09

回復 83# 藍天麗池
我的部分：
ThisWorkbook：

Option Explicit
Private Sub Workbook_Open()
' Nothing to do (保留)
End Sub

複製代碼

shtRTD(RTD)表單:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' 當 Target (總量) 欄位有異動時，則去呼叫 RecordPrice 的方法 (Method)。
If Target.Row = 2 And Target.Column Mod 4 = 0 Then
Call RecordPrice(Target)
End If
End Sub

複製代碼

Module1:

Option Explicit
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
End If
End With
End Sub
Sub 時間()
Sheets("RTD").Cells(2, 1) = WorksheetFunction.Text(Now(), "hh:mm:ss")
Application.OnTime Now() + TimeValue("00:00：01"), "時間"
End Sub
Sub Cls()
With Sheets("RTD")
.Range("A3:OK5000").ClearContents
.[A3].Select
End With
End Sub

複製代碼

作者: c_c_lai 時間: 2016-4-10 15:13

本帖最後由 c_c_lai 於 2016-4-10 15:20 編輯

回復 83# 藍天麗池
.

作者: c_c_lai 時間: 2016-4-10 15:19

本帖最後由 c_c_lai 於 2016-4-10 15:26 編輯

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

作者: c_c_lai 時間: 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 公式的儲存格

作者: 藍天麗池 時間: 2016-4-10 15:50

回復 84# c_c_lai

C大我不太懂你的意思，為什麼位是空白??你往下寫不是就有數字了嗎??

作者: c_c_lai 時間: 2016-4-10 15:53

回復 91# 藍天麗池
"空白" 不懂你的意思？能否永圖表畫個漫畫？

作者: 藍天麗池 時間: 2016-4-10 15:56

回復 84# c_c_lai

時間內容為什麼不能寫入??我後面的計算都要靠時間內容才有辦法運作，可以請C大幫我解惑一下嗎??
我的想法是如果量變動就寫入B2-E2，這樣不行嗎??我們設定量變動才寫入其他有沒有變動應該不影響寫入吧！

作者: 藍天麗池 時間: 2016-4-10 15:57

回復 92# c_c_lai

我不懂的是為什麼時間無法寫入

作者: c_c_lai 時間: 2016-4-10 15:57

本帖最後由 c_c_lai 於 2016-4-10 16:01 編輯

回復 91# 藍天麗池
你是指？
[attach]23788[/attach]
你不是要求資料寫入時不用寫入時間嗎？

作者: 藍天麗池 時間: 2016-4-10 16:00

回復 92# c_c_lai

Sub 時間()
Sheets("RTD").Cells(2, 1) = WorksheetFunction.Text(Now(), "hh:mm:ss")-------------這個地方時間不用寫入
Application.OnTime Now() + TimeValue("00:00：01"), "時間"
End Sub

---------------------------------------------------------------------------------------------------------------------------
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
      End If
End With
End Sub

作者: 藍天麗池 時間: 2016-4-10 16:01

回復 95# c_c_lai

[attach]23789[/attach]
圖裡面的A欄不用寫入，我可能早上表達的不是很清楚，C大抱歉

作者: 藍天麗池 時間: 2016-4-10 16:02

回復 95# c_c_lai

不用寫入時間指的是A欄，其他的要，抱歉，果然是我表達的有問題SORRY

作者: c_c_lai 時間: 2016-4-10 16:05

回復 96# 藍天麗池
那你就將 "時間()" 刪除掉或不去執行它
不就得了。那是你原本的程式。我是不用它的。

作者: 藍天麗池 時間: 2016-4-10 16:07

回復 99# c_c_lai

那目前只往下寫B2-D2，如果要改成往下寫B2-E2要更改哪邊呢??

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)