返回列表 上一主題 發帖

DDE記錄如何複製在不同工作表

DDE記錄如何複製在不同工作表

看了這篇DDE數據每分鐘紀錄下來對於剛接觸VBA不懂的我覺得非常實用
對於如何要記錄 引用GBKEE大大的這句 'R 是A3的公式 =Data!B2 所指的位置 假如這是記錄台指期的DDE 並同時也要記錄電子期與金融期的DDE在不同
的工作表如Sheet5(電子期)與Sheet6(金融期) 不懂的我試著照抄 還是不行請教應該如何做 以下是引用GBKEE大大的VBA 並加入我錯誤的方法
  1. Private Sub Workbook_Open()
  2. If Time >= TimeValue("08:45:00") And Time <= TimeValue("13:45:00") Then
  3. Sheet2.[B7:G307] = ""
  4. change
  5. Else
  6. Application.OnTime "09:01:00", "ThisWorkbook.change"
  7. End If
  8. End Sub
  9. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  10. Private Sub change()
  11.     Dim TimeRange As Range, Rng As Range, R As Range
  12.     With Sheet2
  13.         Set TimeRange = .[A:A].Find(Format(TimeSerial(Hour(Time), Minute(Time), 0), "hh:mm"), LookIn:=xlValues)
  14.         Set Rng = TimeRange.Offset(, 1).Resize(1, 6)
  15.         Set R = Application.Evaluate(Mid(.Range("A3").Formula, 2))
  16.         'R 是A3的公式 =Data!B2 所指的位置
  17.          With Sheet5 '電子期我加入的部分
  18.         Set TimeRange = .[A:A].Find(Format(TimeSerial(Hour(Time), Minute(Time), 0), "hh:mm"), LookIn:=xlValues)
  19.         Set Rng = TimeRange.Offset(, 1).Resize(1, 6)
  20.         Set R = Application.Evaluate(Mid(.Range("A3").Formula, 3))
  21.         'R 是A3的公式 =Data!B2 所指的位置
  22.          With Sheet6 '金融期我加入的部分
  23.         Set TimeRange = .[A:A].Find(Format(TimeSerial(Hour(Time), Minute(Time), 0), "hh:mm"), LookIn:=xlValues)
  24.         Set Rng = TimeRange.Offset(, 1).Resize(1, 6)
  25.         Set R = Application.Evaluate(Mid(.Range("A3").Formula, 4))
  26.         'R 是A3的公式 =Data!B2 所指的位置
  27.     End With
  28.     End With
  29.     End With
  30.     Rng.Value = R.Offset(, 1).Resize(, 6).Value
  31.     If Time > TimeValue("13:45:00") Then Exit Sub
  32.     Application.OnTime Now + TimeValue("00:01"), "ThisWorkbook.change"
  33. End Sub
複製代碼
只會記錄最後一個Sheet6 請大大指導該如何加入 謝謝

本帖最後由 jerrystock 於 2012-2-18 01:04 編輯

回復 2# GBKEE
非常感謝GBKEE大大的指導  可以記錄了  感恩^^

TOP

不好意思可以請問如果數據一直往下記錄 可以不用拉捲軸看最下方數據  
能讓數據往下記錄捲軸跟著往下移動  就可以看到最新記錄而不用拉捲軸嗎?

TOP

今天開盤測試真的可以 好高興 !!
實在很佩服GBKEE大大 面對那麼多疑難雜症都難不倒他且回覆速度之快  真的很有才華
在此說聲非感謝您^^

TOP

不好意思又再次麻煩大大 如果我想在Sheet6參照Sheet2開盤價與收盤價2欄位做觀察
希望Sheet6跟著Sheet2變動 能讓數據往下記錄捲軸跟著往下移動  
就可以看到最新記錄而不用拉捲軸  
希望大大再次指導  謝謝!!
  1. Private Sub change()
  2.     Dim TimeRange As Range, Rng As Range, R As Range
  3.     With Sheet2
  4.         Set TimeRange = .[A:A].Find(Format(TimeSerial(Hour(Time), Minute(Time), 0), "hh:mm"), LookIn:=xlValues)
  5.         Set Rng = TimeRange.Offset(, 1).Resize(1, 6)
  6.         Set R = Application.Evaluate(Mid(.Range("A3").Formula, 2))
  7.         'R 是A3的公式 =Data!B2 所指的位置
  8.         Rng.Value = R.Offset(, 1).Resize(, 6).Value
  9. With Sheet6  '固定在Sheet6觀察Shee2數個欄位
  10.      .Activate
  11.       Rng.Select
  12. End With
  13. End With
  14.     If Time > TimeValue("13:45:00") Then Exit Sub
  15.     Application.OnTime Now + TimeValue("00:01"), "ThisWorkbook.change"
  16. End Sub
複製代碼

TOP

請大大幫我看一下 我用這樣好像不對 我有試過移來移去沒概念不知放在哪裡 但Sheet6我有加
公式 然後Sheet6儲存格有往下拉到Sheet2!B307  麻煩大大了 謝謝
  1. Private Sub Workbook_Open()
  2. If Time >= TimeValue("08:45:00") And Time <= TimeValue("13:45:00") Then
  3. Sheet2.[B7:G307] = ""
  4. change
  5. Else
  6. Application.OnTime "09:01:00", "ThisWorkbook.change"
  7. End If
  8. End Sub
  9. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  10. Private Sub change()
  11.     Dim TimeRange As Range, Rng As Range, R As Range
  12.     With Sheet2
  13.         Set TimeRange = .[A:A].Find(Format(TimeSerial(Hour(Time), Minute(Time), 0), "hh:mm"), LookIn:=xlValues)
  14.         Set Rng = TimeRange.Offset(, 1).Resize(1, 50)
  15.         Set R = Application.Evaluate(Mid(.Range("A3").Formula, 2))
  16.         'R 是A3的公式 =Data!B2 所指的位置
  17. End With
  18.     Rng.Value = R.Offset(, 1).Resize(, 50).Value
  19.     If Time > TimeValue("13:45:00") Then Exit Sub
  20.     Application.OnTime Now + TimeValue("00:01"), "ThisWorkbook.change"
  21. End Sub

  22.     Option Explicit
  23.     Private Sub Worksheet_Calculate()  'Sheet6模組的重算事件
  24.         '需先在Sheet6 寫上公式 已寫上公式
  25.         '這裡有加了A7=Sheet2!B7往下拉   Sheet2的開盤價
  26.         '這裡有加了B7=Sheet2!C7往下拉   Sheet2的收盤價
  27.         '數據從A4往下記錄  例:A4 ="收盤價"
  28.         With Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(1, 18)
  29.             .Value = [A2].Resize(, 18).Value
  30.             .Select
  31.         End With
  32.     End Sub
複製代碼

TOP

回復 10# GBKEE

麻煩大大幫我看看 謝謝
test.zip (106.73 KB)

TOP

謝謝GBKEE大大百忙中抽空指導  最近四天連假等開盤再來試試
我想經大大看過應該是沒問題了  感謝您!!

TOP

        靜思自在 : 能幹不幹,不如苦幹實幹。
返回列表 上一主題