12
返回列表 上一主題 發帖

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

jerrystock

帖子
79 
主題
26 
精華
0 
積分
111 
點名
0  
作業系統
winxp 
軟體版本
office 2010 
閱讀權限
20 
註冊時間
2011-12-20 
最後登錄
2022-8-3 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-2-16 06:30 | 只看該作者

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 請大大指導該如何加入 謝謝
收藏 分享

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2012-2-16 07:56 | 只看該作者
回復 1# jerrystock
幫你多加二句    你是要如此嗎?
  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.        Rng.Value = R.Offset(, 1).Resize(, 6).Value                         ' ***這裡也要: R的數據 指定到 Rng
  18.   With Sheet5 '電子期我加入的部分
  19.         Set TimeRange = .[A:A].Find(Format(TimeSerial(Hour(Time), Minute(Time), 0), "hh:mm"), LookIn:=xlValues)
  20.         Set Rng = TimeRange.Offset(, 1).Resize(1, 6)
  21.         Set R = Application.Evaluate(Mid(.Range("A3").Formula, 3))
  22.         'R 是A3的公式 =Data!B2 所指的位置
  23.          Rng.Value = R.Offset(, 1).Resize(, 6).Value                         ' ****Sheet6的 這裡也要: R的數據 指定到 Rng
  24.          With Sheet6 '金融期我加入的部分
  25.         Set TimeRange = .[A:A].Find(Format(TimeSerial(Hour(Time), Minute(Time), 0), "hh:mm"), LookIn:=xlValues)
  26.         Set Rng = TimeRange.Offset(, 1).Resize(1, 6)
  27.         Set R = Application.Evaluate(Mid(.Range("A3").Formula, 4))
  28.         'R 是A3的公式 =Data!B2 所指的位置
  29.          Rng.Value = R.Offset(, 1).Resize(, 6).Value                        'R的數據 指定到 Sheet6的 Rng
  30.     End With
  31.     End With
  32.     End With
  33.        If Time > TimeValue("13:45:00") Then Exit Sub
  34.     Application.OnTime Now + TimeValue("00:01"), "ThisWorkbook.change"
  35. End Sub
複製代碼

TOP

jerrystock

帖子
79 
主題
26 
精華
0 
積分
111 
點名
0  
作業系統
winxp 
軟體版本
office 2010 
閱讀權限
20 
註冊時間
2011-12-20 
最後登錄
2022-8-3 
3#
發表於 2012-2-17 23:14 | 只看該作者
本帖最後由 jerrystock 於 2012-2-18 01:04 編輯

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

TOP

jerrystock

帖子
79 
主題
26 
精華
0 
積分
111 
點名
0  
作業系統
winxp 
軟體版本
office 2010 
閱讀權限
20 
註冊時間
2011-12-20 
最後登錄
2022-8-3 
4#
發表於 2012-2-19 15:15 | 只看該作者
不好意思可以請問如果數據一直往下記錄 可以不用拉捲軸看最下方數據  
能讓數據往下記錄捲軸跟著往下移動  就可以看到最新記錄而不用拉捲軸嗎?

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2012-2-19 16:10 | 只看該作者
回復 4# jerrystock
  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                         ' ***這裡也要: R的數據 指定到 Rng
  9.         .Activate
  10.         Rng.Select
  11.         With Sheet5 '電子期我加入的部分
  12.             Set TimeRange = .[A:A].Find(Format(TimeSerial(Hour(Time), Minute(Time), 0), "hh:mm"), LookIn:=xlValues)
  13.             Set Rng = TimeRange.Offset(, 1).Resize(1, 6)
  14.             Set R = Application.Evaluate(Mid(.Range("A3").Formula, 3))
  15.             'R 是A3的公式 =Data!B2 所指的位置
  16.             Rng.Value = R.Offset(, 1).Resize(, 6).Value                         ' ****Sheet6的 這裡也要: R的數據 指定到 Rng
  17.             .Activate
  18.             Rng.Select
  19.             With Sheet6 '金融期我加入的部分
  20.                 Set TimeRange = .[A:A].Find(Format(TimeSerial(Hour(Time), Minute(Time), 0), "hh:mm"), LookIn:=xlValues)
  21.                 Set Rng = TimeRange.Offset(, 1).Resize(1, 6)
  22.                 Set R = Application.Evaluate(Mid(.Range("A3").Formula, 4))
  23.                 'R 是A3的公式 =Data!B2 所指的位置
  24.                 Rng.Value = R.Offset(, 1).Resize(, 6).Value                        'R的數據 指定到 Sheet6的 Rng
  25.                 .Activate
  26.                 Rng.Select
  27.             End With
  28.         End With
  29.     End With
  30.     If Time > TimeValue("13:45:00") Then Exit Sub
  31.     Application.OnTime Now + TimeValue("00:01"), "ThisWorkbook.change"
  32. End Sub
複製代碼

TOP

jerrystock

帖子
79 
主題
26 
精華
0 
積分
111 
點名
0  
作業系統
winxp 
軟體版本
office 2010 
閱讀權限
20 
註冊時間
2011-12-20 
最後登錄
2022-8-3 
6#
發表於 2012-2-20 21:58 | 只看該作者
今天開盤測試真的可以 好高興 !!
實在很佩服GBKEE大大 面對那麼多疑難雜症都難不倒他且回覆速度之快  真的很有才華
在此說聲非感謝您^^

TOP

jerrystock

帖子
79 
主題
26 
精華
0 
積分
111 
點名
0  
作業系統
winxp 
軟體版本
office 2010 
閱讀權限
20 
註冊時間
2011-12-20 
最後登錄
2022-8-3 
7#
發表於 2012-2-22 14:09 | 只看該作者
不好意思又再次麻煩大大 如果我想在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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2012-2-22 15:23 | 只看該作者
回復 7# jerrystock
  1. Option Explicit
  2. Private Sub Worksheet_Calculate()  'Sheet6模組的重算事件
  3.     '需先在Sheet6 寫上公式
  4.     '如 A2=Sheet2!A1   Sheet2的開盤價
  5.     '如 B2=Sheet2!B1   Sheet2的收盤價
  6.     '數據從A4往下記錄  例:A4 ="收盤價"
  7.     With Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(1, 2)
  8.         .Value = [A2].Resize(, 2).Value
  9.         .Select
  10.     End With
  11. End Sub
複製代碼

TOP

jerrystock

帖子
79 
主題
26 
精華
0 
積分
111 
點名
0  
作業系統
winxp 
軟體版本
office 2010 
閱讀權限
20 
註冊時間
2011-12-20 
最後登錄
2022-8-3 
9#
發表於 2012-2-23 12:49 | 只看該作者
請大大幫我看一下 我用這樣好像不對 我有試過移來移去沒概念不知放在哪裡 但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

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

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 2012-2-23 13:29 | 只看該作者
回復 9# jerrystock
Private Sub Worksheet_Calculate()  'Sheet6模組的重算事件
你是複製在Sheet6模組內嗎? 如果是 還有疑問 請附檔來看看 .

TOP

        靜思自在 : 信心、毅力、勇氣三者具備，則天下沒有做不成的事。
12
返回列表 上一主題