Board logo

標題: 『已解決』陣列比較,找出差異的儲存格 [打印本頁]

作者: ko310kmo    時間: 2011-5-11 00:32     標題: 『已解決』陣列比較,找出差異的儲存格

本帖最後由 ko310kmo 於 2011-5-14 17:06 編輯

[attach]6117[/attach]
DDE傳值的方式只能觸動Calculate事件,而無法觸動Change事件

sheet1的
B欄是各個價位
C欄是成交價
D欄是單量
C、D欄持續接受DDE傳值

本來是用Calculate事件處理,但無法找出真正變動的儲存格,會造成資料重複的錯誤


現在我想到的辦法是:
第一次變動就把D欄寫入第一個陣列
第二次變動就把變動後的D欄寫入第二個陣列
再二個陣列比較,以找出是哪一個儲存格在變動,藉此找出其所屬的價位,再把價、量變動後的資料寫入其價位所屬的工作表

但我對陣列的寫作方式還不熟悉,搜尋論壇文章,也沒有相似的篇幅,請各位大大幫忙!!
或者大家有更好的辦法可以找出主要變動的儲存格的方法的想法可以提供參考,希望大家幫幫忙,謝謝!!
作者: Hsieh    時間: 2011-5-11 11:13

回復 1# ko310kmo
就用你的邏輯
  1. Dim ar
  2. Private Sub Worksheet_Calculate()
  3. If IsEmpty(ar) Then ar = [B2:D13]: Exit Sub
  4. Set rng = [B2:D13]
  5. For I = 1 To UBound(ar, 1)
  6.     If ar(I, 2) & ar(I, 3) <> rng(I, 2) & rng(I, 3) Then
  7.        With Sheets(CStr(ar(I, 1)))
  8.           Set a = .[H65536].End(xlUp).Offset(1)
  9.           a = rng(I, 1): a.Offset(, 1) = rng(I, 2): a.Offset(, 3) = rng(I, 3)
  10.        End With
  11.     End If
  12. Next
  13. ar = rng
  14. End Sub
複製代碼

作者: GBKEE    時間: 2011-5-11 16:21

回復 1# ko310kmo
  1. Dim A, B, TheTime As Date, AR, 開盤價
  2. Private Sub Worksheet_Calculate()
  3.     Dim E, i%
  4.     On Error GoTo t     '處理 即時成交價與成單量 範圍沒有錯誤值
  5.     If Not Range("C2", Range("D2").End(xlDown)).SpecialCells(xlCellTypeFormulas, xlErrors) Is Nothing Then
  6.         Exit Sub      '此檔案初開始連結時即啟動重算 ->但是尚有未連結到的儲存格會傳回錯誤值
  7.     End If
  8. t:
  9.     A = Application.Transpose(Range("C2", Range("D2").End(xlDown)).Value)   '即時成交價與成單量範圍陣列
  10.     If TheTime <> TimeSerial(Hour(Time), Minute(Time), 0) Then   '設定每分鐘整
  11.         ReDim AR(2 To Range("b2").End(xlDown).Row, 1 To 6)
  12.         Ex
  13.         TheTime = TimeSerial(Hour(Time), Minute(Time), 0)
  14.     Else
  15.         Ex
  16.     End If
  17.     If IsEmpty(B) Then                      '比對陣列為資料
  18.         For Each E In Range("b2", Range("b2").End(xlDown))
  19.             With Sheets(E.Text).Cells(Rows.Count, "j").End(xlUp)
  20.                 .Offset(1) = E(1, 2)        '記錄下 成交價
  21.                 .Offset(1, 1) = E(1, 3)     '記錄下 單量
  22.                 .Offset(1, 2).Resize(1, 6) = Application.Index(AR, E.Row - 1)  '讀取一分鐘內的資料
  23.             End With
  24.         Next
  25.     Else
  26.         For i = 1 To UBound(A, 2)
  27.             If A(1, i) <> B(1, i) Or A(2, i) <> B(2, i) Then        ' 履約價的(成交價或成單量)有變動
  28.                 With Sheets([B2].Cells(i, 1).Text).Cells(Rows.Count, "j").End(xlUp)
  29.                     .Offset(1) = [B2].Cells(i, 2)       '記錄下 即時成交價
  30.                     .Offset(1, 1) = [B2].Cells(i, 3)    '記錄下 單量
  31.                     .Offset(1, 2).Resize(1, 6) = Application.Index(AR, i)  '讀取一分鐘內的資料
  32.                 End With
  33.             End If
  34.         Next
  35.     End If
  36.     B = A
  37. End Sub
複製代碼
  1. Sub Ex()   'Sheet1的程式碼    你發問的那篇 [dde tick資料轉換分鐘資料]
  2.     '請問收盤價是何時的價格
  3.     Dim i%
  4.     For i = 2 To [B1].End(xlDown).Row
  5.         If TheTime <> TimeSerial(Hour(Time), Minute(Time), 0) Then
  6.             AR(i, 1) = TimeSerial(Hour(Time), Minute(Time), 0)  '每分鐘時間
  7.             If IsEmpty(B) Then
  8.                 If IsEmpty(開盤價) Then ReDim 開盤價(2 To UBound(AR))
  9.                 開盤價(i) = Cells(i, "C")       '開盤價
  10.             End If
  11.             AR(i, 2) = 開盤價(i)
  12.             AR(i, 3) = Cells(i, "C")  '每分鐘的最高價
  13.             AR(i, 4) = Cells(i, "C")  '每分鐘的最低價
  14.            ' AR(i, 5) = Cells(i, "C")  '請問收盤價是何時的價格
  15.             AR(i, 6) = Cells(i, "D")  '每分鐘的成交量
  16.         Else
  17.             AR(i, 3) = IIf(Cells(i, "C") > AR(i, 3), Cells(i, "C"), AR(i, 3)) '每分鐘的最高價
  18.             AR(i, 4) = IIf(Cells(i, "C") < AR(i, 4), Cells(i, "C"), AR(i, 4)) '每分鐘的最低價
  19.            ' AR(i, 5) = Cells(i, "C")                                          '每分鐘的收盤價
  20.             AR(i, 6) = AR(i, 6) + Cells(i, "D")                              '每分鐘的成交量
  21.         End If
  22.     Next
  23. End Sub
複製代碼

作者: ko310kmo    時間: 2011-5-11 21:27

回復 2# Hsieh
謝謝大大的解惑,有幾個問題想請教,

Dim ar
Private Sub Worksheet_Calculate()
If IsEmpty(ar) Then ar = [B2:D13]: Exit Sub
如果是空值ar = [B2:D13],否則就結束sub的意思嗎?

Set rng = [B2:D13]    是設成陣列的意思嗎? rng是range的意思嗎? 還是是代號而已?]

For I = 1 To UBound(ar, 1)
    If ar(I, 2) & ar(I, 3) <> rng(I, 2) & rng(I, 3) Then
   為什麼會知道ar、rng是變動前後的陣列?

       With Sheets(CStr(ar(I, 1)))
          Set a = .[H65536].End(xlUp).Offset(1)
所屬工作表的h欄最後一筆有資料的欄位的下一列。 是這意思對吧!!   但它的下一行不是空白嗎?

          a = rng(I, 1): a.Offset(, 1) = rng(I, 2): a.Offset(, 3) = rng(I, 3)
       End With
    End If
Next
ar = rng   
End Sub  

紅字的部分是我還不太明白的意思,希望大大能為我解惑一下,謝謝你、麻煩你了!!!
作者: ko310kmo    時間: 2011-5-11 21:35

回復 3# GBKEE

收盤價,是這一分鐘內,最後接收的一個資料!!
ex:   08:45:00~08:45:59

大大
第二個程式要放在sheet1嗎?
不是放在thisworkbook或者一般模組嗎?

我之前把它跟Calculate事件都放在sheet1,
這個程式就會跑不出正常值,資料會亂跳的問題。

謝謝大大的熱心回答
這兩程式我再自已好好研究一下,有問題再請教大大,
謝謝大大的幫忙!!!
作者: GBKEE    時間: 2011-5-11 21:55

回復 5# ko310kmo
全部置於Sheet1
Calculate事件 是工作表的預設事件
這個Ex程序 是依放在Sheet1物件的模組所寫的
作者: Hsieh    時間: 2011-5-11 23:23

回復 4# ko310kmo
Dim ar  '宣告一個靜態陣列變數
Private Sub Worksheet_Calculate()
If IsEmpty(ar) Then ar = [B2:D13]: Exit Sub
如果是空值ar = [B2:D13],否則就結束sub的意思嗎?  '如果這個靜態陣列還沒建立,表示開啟檔案後第一次重算時,所以不必做任何比較就退出程序

Set rng = [B2:D13]    是設成陣列的意思嗎? rng是range的意思嗎? 還是是代號而已?]  '這個rng變數是個Range型態的變數,就是指向你DDE公式所在的範圍

For I = 1 To UBound(ar, 1)   '當靜態陣列有被寫入元素的值才會進到此循環
    If ar(I, 2) & ar(I, 3) <> rng(I, 2) & rng(I, 3) Then  '比較陣列跟範圍的值是否一樣
   為什麼會知道ar、rng是變動前後的陣列?
因為ar是程序最後把rng的值反過來設給ar,所以ar就變成前一次rng的值
       With Sheets(CStr(ar(I, 1)))
          Set a = .[H65536].End(xlUp).Offset(1)
所屬工作表的h欄最後一筆有資料的欄位的下一列。 是這意思對吧!!   但它的下一行不是空白嗎?
'是資料尾的下一列空白沒錯,你不是要把這些紀錄寫到對應的工作表內嗎?

          a = rng(I, 1): a.Offset(, 1) = rng(I, 2): a.Offset(, 3) = rng(I, 3)
       End With
    End If
Next
ar = rng   '將rng的值設給ar ,做下一次重算的比對基礎
End Sub
作者: ko310kmo    時間: 2011-5-12 01:26

回復 7# Hsieh


謝謝大大詳細、耐心的解釋
我都大概了解了
我會再測試看看,謝謝大大的幫忙!!!!
作者: ko310kmo    時間: 2011-5-12 01:57

本帖最後由 ko310kmo 於 2011-5-12 02:09 編輯

回復 6# GBKEE
謝謝大大的熱心幫助,想先請教幾個問題


A = Application.Transpose(Range("C2", Range("D2").End(xlDown)).Value)   '即時成交價與成單量範圍陣列
    If TheTime <> TimeSerial(Hour(Time), Minute(Time), 0) Then   '設定每分鐘整
        ReDim AR(2 To Range("b2").End(xlDown).Row, 1 To 6)
        Ex
        TheTime = TimeSerial(Hour(Time), Minute(Time), 0)
    Else
        Ex
    End If
 不太懂的這段的意思
    If IsEmpty(B) Then                      '比對陣列為資料
        For Each E In Range("b2", Range("b2").End(xlDown))
            With Sheets(E.Text).Cells(Rows.Count, "j").End(xlUp)
                .Offset(1) = E(1, 2)        '記錄下 成交價
                .Offset(1, 1) = E(1, 3)     '記錄下 單量
                .Offset(1, 3).Resize(1, 6) = Application.Index(AR, E.Row - 1)  '讀取一分鐘內的資料
       為什麼要讀取一分鐘的資料?
            End With
        Next
    Else
        For i = 1 To UBound(A, 2)
            If A(1, i) <> B(1, i) Or A(2, i) <> B(2, i) Then        ' 履約價的(成交價或成單量)有變動
                With Sheets([B2].Cells(i, 1).Text).Cells(Rows.Count, "j").End(xlUp)
請問[B2]是什麼意思,本來以為是Range("B2"),但感覺好像有不對...

                    .Offset(1) = [B2].Cells(i, 2)       '記錄下 即時成交價
                    .Offset(1, 1) = [B2].Cells(i, 3)    '記錄下 單量
                    .Offset(1, 2).Resize(1, 6) = Application.Index(AR, i)  '讀取一分鐘內的資料

-------------------------------------------------------------------------------------

我照大大的檔,再依我個人需求,再做了少部分的修改
說明一下我主要的架構
sheet1接受DDE的值
某一列的成交價一變動,就馬上把它的價、量、變動的時間(第幾分幾秒發生跳動的時間)
記入到它所屬的工作表,一直往下紀錄(J∼L欄)(秒的資料)
並每到一分鐘就把算出它一分鐘內的開、高、低、收、成交量(M∼R欄)[attach]6133[/attach]
作者: GBKEE    時間: 2011-5-12 09:34

本帖最後由 GBKEE 於 2011-5-12 10:52 編輯

回復 9# ko310kmo
If TheTime <> TimeSerial(Hour(Time), Minute(Time), 0) Then
檔案一執行時 TheTime <> TimeSerial(Hour(Time), Minute(Time), 0)
執行之後有設定 TheTime = TimeSerial(Hour(Time), Minute(Time), 0)
經時間到下一分鐘後 TheTime <> TimeSerial(Hour(Time), Minute(Time), 0)
ReDim AR(2 To Range("b2").End(xlDown).Row, 1 To 6)
將 AR陣列 重新初始化  (歸零)
.Offset(1, 3).Resize(1, 6) = Application.Index(AR, E.Row - 1)  '讀取一分鐘內的資料
AR陣列是紀錄一分鐘內各履約價的 時間, 開, 高, 低, 收, 量
請問[B2]是什麼意思
http://forum.twbts.com/viewthread.php?tid=2811&from=favorites
*******************************************************
重新修改試試看 但與你的期望尚有距離
  1. Private Sub Worksheet_Calculate()
  2. Dim E, i%
  3. On Error GoTo t '處理 即時成交價與成單量 範圍沒有錯誤值
  4. If Not Range("C2", Range("D2").End(xlDown)).SpecialCells(xlCellTypeFormulas, xlErrors) Is Nothing Then
  5. Exit Sub '此檔案初開始連結時即啟動重算 ->但是尚有未連結到的儲存格會傳回錯誤值
  6. End If
  7. t:
  8. A = Application.Transpose(Range("C2", Range("D2").End(xlDown)).Value) '即時成交價與成單量範圍陣列
  9. If TheTime <> TimeSerial(Hour(Time), Minute(Time), 0) Then '設定每分鐘整
  10. ReDim AR(2 To Range("b2").End(xlDown).Row, 1 To 6) '陣列 重新初始化 (歸零)
  11. 開盤價 = Empty '變數初始化 (歸零)
  12. Ex
  13. If Not IsEmpty(B) Then
  14. For Each E In Range("b2", Range("b2").End(xlDown))
  15. Sheets(E.Text).Cells(Rows.Count, "j").End(xlUp).Offset(, 6) = B(1, E.Row - 1) '一分鐘結束時的價格
  16. Next
  17. End If
  18. TheTime = TimeSerial(Hour(Time), Minute(Time), 0)
  19. Else
  20. Ex
  21. End If
  22. If IsEmpty(B) Then '比對陣列為資料
  23. For Each E In Range("b2", Range("b2").End(xlDown))
  24. With Sheets(E.Text).Cells(Rows.Count, "j").End(xlUp)
  25. .Offset(1) = E(1, 2) '記錄下 成交價
  26. .Offset(1, 1) = E(1, 3) '記錄下 單量
  27. .Offset(1, 2).Resize(1, 6) = Application.Index(AR, E.Row - 1) '讀取一分鐘內的資料
  28. End With
  29. Next
  30. Else
  31. For i = 1 To UBound(A, 2)
  32. If A(1, i) <> B(1, i) Or A(2, i) <> B(2, i) Then ' 履約價的(成交價或成單量)有變動
  33. With Sheets([B2].Cells(i, 1).Text).Cells(Rows.Count, "j").End(xlUp)
  34. .Offset(1) = [B2].Cells(i, 2) '記錄下 即時成交價
  35. .Offset(1, 1) = [B2].Cells(i, 3) '記錄下 單量
  36. .Offset(1, 2).Resize(1, 6) = Application.Index(AR, i) '讀取一分鐘內的資料
  37. End With
  38. End If
  39. Next
  40. End If
  41. B = A
  42. End Sub
  43. Sub Ex() 'Sheet1的程式碼 你發問的那篇 [dde tick資料轉換分鐘資料]
  44. Dim i%
  45. If IsEmpty(開盤價) Then
  46. ReDim 開盤價(2 To UBound(AR))
  47. For i = 2 To [B1].End(xlDown).Row
  48. 開盤價(i) = Cells(i, "C")
  49. Next
  50. End If
  51. For i = 2 To [B1].End(xlDown).Row
  52. If TheTime <> TimeSerial(Hour(Time), Minute(Time), 0) Then
  53. AR(i, 1) = Time 'TimeSerial(Hour(Time), Minute(Time), 0) '時間
  54. AR(i, 2) = 開盤價(i) '每分鐘開盤價
  55. AR(i, 3) = Cells(i, "C") '每分鐘的最高價
  56. AR(i, 4) = Cells(i, "C") '每分鐘的最低價
  57. AR(i, 6) = Cells(i, "D") '每分鐘的成交量
  58. Else
  59. AR(i, 1) = Time
  60. AR(i, 3) = IIf(Cells(i, "C") > AR(i, 3), Cells(i, "C"), AR(i, 3)) '每分鐘的最高價
  61. AR(i, 4) = IIf(Cells(i, "C") < AR(i, 4), Cells(i, "C"), AR(i, 4)) '每分鐘的最低價
  62. 'AR(i, 5) = Cells(i, "C") '每分鐘的收盤價
  63. AR(i, 6) = AR(i, 6) + Cells(i, "D") '每分鐘的成交量
  64. End If
  65. Next
  66. End Sub
複製代碼

作者: ko310kmo    時間: 2011-5-12 09:49

回復 5# ko310kmo

大大
Calculate已經會一觸發,就寫入相對的工作表,不會讓其他工作表重複寫入了
但比較尾部的工作表會出現第一個歷史成交價、單量為0的狀況,會造成後面四個價的判斷問題
而且分鐘資料會重複跳出
每一分鐘只會有一筆,但卻會同一分鐘出現二、三筆的問題

我資料顯示的方式是希望像附檔[attach]6136[/attach],也就是只前發問的這樣
每秒紀錄所以接受的值,再每分鐘結算它這一分內的開、高、低、收、成交量
但這檔會出現的問題是,它的Calculate無法得知是哪個儲存格跳動
會所以工作表都寫入一次,會造成資料錯誤的問題

謝謝大大的幫忙!!!!!
作者: ko310kmo    時間: 2011-5-12 10:43

回復 2# Hsieh

大大
我原本的檔有稍做修改,但應該不致於造成太大的問題
但大大的Calculate會在『    If arr(I, 2) & arr(I, 3) <> rng(I, 2) & rng(I, 3) Then』發生黃底『型態不符合』的錯誤?
研究了一下還是發不出原因,希望大大賜教[attach]6140[/attach]
因為一般模組中已有寫了一個陣列ar,所以有將大大的ar 改為arr
作者: GBKEE    時間: 2011-5-12 11:40

回復 11# ko310kmo
Worksheet_Calculate 事件 是當工作表的任一個公式所傳回的數值有改變即執行的程式
所以你附檔 ok.5.10 的程式碼會使用迴圈將Range("B2:B" & M)範圍內的工作表一一的寫入資料
請在參考 10樓 的程式碼試試看 但用Worksheet_Calculate來記錄還是會有誤差的
如成交價不變   00:10:01時的成交量是 10  下一次的成交在 00:10:11 時的成交量 還是 10
如此Worksheet_Calculate 是不會執行的 誤差就產生  , 所以建議有 成交價及成交量 的時間欄 來參考.
作者: ko310kmo    時間: 2011-5-12 11:59

本帖最後由 ko310kmo 於 2011-5-14 17:12 編輯

回復 13# GBKEE

大大我了解了
我本來是用即時成交價、單量
我想再用一個成交量來看變動



我自行依你提供的幾個程式,修改後
Calculate已經可以正確寫入了

現在會出現的問題是
分鐘資料是2分鐘更新一次

我是先執行 test1,等它跑完再執行test3
這樣是可以每分更新的

如果我是先執行test1再執行test2,沒有設定test3
這樣分鐘資料只會更新第一遍。

請問這到底是該如何修改才好呢?
懇請大大賜教!!!
作者: GBKEE    時間: 2011-5-12 20:02

回復 14# ko310kmo
如果我是先執行test1再執行test2,沒有設定test3,這樣分鐘資料只會更新第一遍。
不要用test3了
test2 最後加上
If Time <= #1:30:00 PM# Then Application.OnTime Now + TimeValue("00:01:00"), "test2"
End Sub
作者: ko310kmo    時間: 2011-5-12 22:28

本帖最後由 ko310kmo 於 2011-5-13 10:10 編輯

回復 15# GBKEE

請問大大
        If Minute(Time) = Minute(t) Then
            Do While Minute(Time) = Minute(t)

這二行的意思是
一直做到這一分鐘過完對吧!
而我們後面又寫Application.OnTime Now + TimeValue("00:01:00"), "test2"
所以會不會是因為這樣,才會造成二分鐘記錄一次呢?

我在想是不是,不用加Application.OnTime
而把大大原本的程式最後寫的
Loop Until Time <= #1:30:00 PM#
改成
Loop Until Time >= #1:30:00 PM#


loop until time<=1:30
做到時間小於1點30就跳出,測試的時間一定都是小於1:30的,所以才跳跑一遍而已,就跳出


大大,今日測試結果,只要把<改成>就沒有問題了,謝謝大大的幫忙與耐心講解!!!:)
作者: ko310kmo    時間: 2011-5-17 16:46

回復 10# GBKEE
大大對於程式碼的寫法,還有幾點想請教


If IsEmpty(B) Then                      '比對陣列為資料
        For Each E In Range("b2", Range("b2").End(xlDown))
            With Sheets(E.Text).Cells(Rows.Count, "j").End(xlUp)
                .Offset(1) = E(1, 2)        '記錄 成交價
                .Offset(1, 1) = E(1, 3)     '記錄 單量
                .Offset(1, 2) = Time        '記錄 成交時間
            End With
        Next
E(1, 2)這寫法是什麼意思?
    Else
        For i = 1 To UBound(A, 2)
            If A(1, i) <> B(1, i) Or A(2, i) <> B(2, i) Or A(3, i) <> B(3, i) Then ' 履約價的(成交價或成單量)有變動
                With Sheets([B2].Cells(i, 1).Text).Cells(Rows.Count, "j").End(xlUp)
                    .Offset(1) = [B2].Cells(i, 2)       '記錄下 即時成交價
                    .Offset(1, 1) = [B2].Cells(i, 3)    '記錄下 單量
                    .Offset(1, 2) = Time
                End With
            End If
        Next
    End If
[B2].Cells(i, 3)
雖然看了大大貼的網址的教學
所以是  range("B2").cells(i,3) 的意思嗎?
看了好久,還是不太了解
請大大解釋一下,謝謝!!!  

作者: GBKEE    時間: 2011-5-17 18:59

回復 17# ko310kmo
[B2] = [B2](1, 1) = [B2].Cells(1, 1) = Rrange("B2").cells(1,1) => [B2].Offset( 0 , 0 ) => Rrange("B2")
[B2](2, 3) = [B2].Cells(2, 3) =  Rrange("B2").cells(2,3) => Rrange("B2").Offset( 1, 2 )=>Rrange("D3")




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