返回列表 上一主題 發帖

[發問] DDE資料紀錄問題

本帖最後由 GBKEE 於 2012-4-26 18:01 編輯

回復 4# c_c_lai
工作表2 的欄位 須設好格式
為什麼 工作表1 的 A2 資料一轉到 工作表2 的欄位,01:44 PM -> 0.572905 ?
0.572905是數字   01:44 PM 是儲存格的格式

Sheets("工作表2").Cells(CIndex + 2, 1) = Sheets("工作表1").Cells(2, 1).Text

TOP

本帖最後由 GBKEE 於 2012-6-22 08:25 編輯

回復 11# usana642
本身的模組中 直接呼叫  程序名稱即可 ->  GetDDE

物件模組內 :工作表物件模組 (SHEET1 . SHEET2.....) , 活頁簿物件模組 ThisWorkbook ,中
公用:   Sub  GetDDE ()  =    Public Sub  GetDDE ()     Public  模組層次的關鍵字,用來宣告在所有模組裏的所有程序中都可以使用常數
在其他模組的程序中 乎叫GetDDE    ->    SHEET1.GetDDE
私用:  Private  Sub  GetDDE ()                                        Private 模組層次的關鍵字,用來宣告只在已宣告的模組裏才可以使用常數
在其他模組的程序中 乎叫GetDDE   ->     Run  "SHEET1.GetDDE"

一般模組內 :   Module1,中
Sub  GetDDE ()  =    Public Sub  GetDDE ()     在其他模組的程序中 乎叫GetDDE  ->      GetDDE
私用:  Private  Sub  GetDDE ()     在其他模組的程序中 乎叫GetDDE    ->    Run  "Module1.GetDDE"

TOP

回復 13# 14# usana642
可附檔上來看你如何寫的
PS:請按回復鍵 回文者才會知道的

TOP

本帖最後由 GBKEE 於 2013-7-16 07:09 編輯

回復 16# usana642
  1. Option Explicit
  2. Sub Auto_Open() '開檔時自動執行此巨集
  3.     GetDDE  '呼叫程序
  4. End Sub
  5. Sub GetDDE()
  6.     Dim T As Date, A
  7.     'T = Now  'Now 包含日期     >1,,' T = Time '只有24小時的數值 <1
  8.     '輸入  #9:00#  ->系統自動成  #9:00:00 AM#
  9.     '輸入  #13:00# ->系統自動成  #1:00:00 PM#
  10.     '輸入  #00:05# ->系統自動成  #12:05:00 AM#   :  5分鐘
  11.     '------  1.再加入台股或美股開收盤時間,來設定接收時間
  12.     If Time > #9:00:00 AM# And Time < #1:30:00 PM# Then    '於交易時間內
  13.         If Not IsError(Sheets(1).[B2]) Then Sheets(2).[A65536].End(xlUp).Offset(1).Resize(, 7) = Sheets(1).[A2:G2].Value  '工作表1的資料DDE連結成功寫入工作表2
  14.     '------  2.將接收進來的資料時間修正為" 分鐘整數",例如 10:15:10  ---> 10:15:00
  15.     End If
  16.     T = Time + #12:00:30 AM#                         '--間隔30秒---------
  17.     'T = Time + #12:01:00 AM#                         '--間隔1分鐘---------
  18.     'T = Time + #12:05:00 AM#                         '--間隔5分鐘---------
  19.     Application.OnTime T, "GetDDE"
  20. End Sub
複製代碼

TOP

本帖最後由 GBKEE 於 2013-7-15 20:08 編輯

回復 19# slip
  1. '如程式碼ThisWorkbook物件模組中
  2. Private Sub Workbook_Open() 'ThisWorkbook物件模組:開啟擋預設自動執行的程序事件
  3.      GetDDE  '呼叫程序
  4. End Sub
  5. Sub GetDDE()
  6.     Dim T As Date
  7.     T = Now  '取得現在時間
  8.     If Not IsError(Sheets(1).[B2]) Then Sheets(2).[A65536].End(xlUp).Offset(1).Resize(, 7) = Sheets(1).[A2:G2].Value  '工作表1的資料DDE連結成功寫入工作表2
  9.     Application.OnTime T + TimeValue("00:00:30"), "ThisWorkbook.GetDDE"  '這是以2秒測試,間隔5分鐘改成TimeValue("00:05:00"),
  10.     'ThisWorkbook是物件模組,須加上模組的名稱
  11. End Sub
複製代碼
2# Hsieh超版 有說:[一般模組輸入以下程式碼,存檔後開啟檔案,測試看看] 如圖

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 21# slip
這是正常的,可再參考一下17#的程式碼.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 24# slip
先刪除H:I欗的公式
  1. Sub GetDDE()
  2.     Dim T As Date
  3.     T = Now  '取得現在時間
  4.     If Not IsError(Sheets(1).[B2]) Then
  5.         With Sheets(2).[A65536].End(xlUp).Offset(1)
  6.             .Resize(, 7) = Sheets(1).[A2:G2].Value  '工作表1的資料DDE連結成功寫入工作表2
  7.             .Range("H1") = .Range("D1") - .Range("C1")             'H欗的公式=>D欗-C欗
  8.             .Range("I1") = .Range("E1")                                  'I欗的公式=E欗
  9.         End With
  10.     End If
  11.     Application.OnTime T + TimeValue("00:01:00"), "GetDDE"  '這是以2秒測試,間隔5分鐘改成TimeValue("00:05:00"),
  12. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 26# slip
  1. Sub GetDDE()
  2.     Dim T As Date, xMax As Integer, xMin As Integer
  3.     T = Now  '取得現在時間
  4.     If Not IsError(Sheets(1).[B2]) Then
  5.         With Sheets(2).[A65536].End(xlUp).Offset(1)
  6.             .Resize(, 7) = Sheets(1).[A2:G2].Value                      '工作表1的資料DDE連結成功寫入工作表2
  7.             .Range("H1") = .Range("D1") - .Range("C1")                  'H欗的公式=>D欗-C欗
  8.             .Range("I1") = .Range("H1") - .Range("H1").Offset(-1)       'I413=H413-H412......數列2
  9.             .Range("J1") = .Range("E1")                                 'J欗的公式=E欗
  10.             xMax = Application.Max(.Parent.[i:j])                       '最大值
  11.             xMin = Application.Min(.Parent.[i:j])                       '最小值
  12.             
  13.             '**  .Parent.ChartObjects(1): 物件 (工作表的第1個圖表)  *****
  14.             With .Parent.ChartObjects(1).Chart.Axes(xlValue)
  15.                 .MinimumScale = xMin
  16.                 .MaximumScale = xMax
  17.                 .ScaleType = xlLinear                                    '數值座標軸的刻度類型
  18.             End With
  19.         End With
  20.     End If
  21.     Application.OnTime T + TimeValue("00:01:00"), "GetDDE"               '間隔5分鐘改成TimeValue("00:05:00"),
  22. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 28# slip
試試看
  1. Sub GetDDE()
  2.     Dim T As Date, xMax As Integer, xMin As Integer, i As Integer
  3.     T = Now  '取得現在時間
  4.     If Not IsError(Sheets(1).[B2]) Then
  5.         Application.ScreenUpdating = False
  6.         With Sheets(2).[A65536].End(xlUp).Offset(1)                     '物件
  7.             i = .Row                                                    'Row(物件屬性):列號
  8.             .Resize(, 7) = Sheets(1).[A2:G2].Value                      '工作表1的資料DDE連結成功寫入工作表2
  9.             .Range("H1") = .Range("D1") - .Range("C1")                  'H欗的公式=>D欗-C欗
  10.             .Range("I1") = .Range("H1") - .Range("H1").Offset(-1)       'I413=H413-H412......數列2
  11.             .Range("J1") = .Range("E1")                                 'J欗的公式=E欗
  12.             xMax = Application.Max(.Parent.[i:j])                       '最大值
  13.             xMin = Application.Min(.Parent.[i:j])                       '最小值
  14.             '**  .Parent.ChartObjects(1): 物件 (工作表的第1個圖表)  *****
  15.             With .Parent.ChartObjects(1).Chart
  16.                 .SeriesCollection(1).Values = .Parent.Parent.Range("J2:J" & i)              '指定數列資料的範圍
  17.                 .SeriesCollection(1).ChartType = 52                                         '指定數列圖表類型
  18.                 .SeriesCollection(2).Values = .Parent.Parent.Range("i2:i" & i)
  19.                 .SeriesCollection(2).ChartType = 65
  20.                 If .SeriesCollection(2).AxisGroup <> xlSecondary Then .SeriesCollection(2).AxisGroup = xlSecondary '數列不在第2Y座標軸(副座標): 數列指定到第2Y座標軸(副座標)
  21.                                                                                             '.AxisGroup = 2 ->  副座標
  22.                 .Parent.Top = .Parent.Parent.Range("L" & IIf(i <= 39, 1, i - 38)).Top       '指定圖表頂端的位置
  23.                 With .Axes(xlValue)             'Y座標軸
  24.                     .MinimumScale = xMin
  25.                     .MaximumScale = xMax
  26.                     .MajorUnitIsAuto = True      '主要刻度間距=自動設定
  27.                     .MinorUnitIsAuto = True      '次要刻度間距=自動設定
  28.                     .Crosses = xlAutomatic       '座標軸與其他座標軸交叉的點=自動設定
  29.                     .ScaleType = xlLinear        '數值座標軸的刻度類型=xlLinear
  30.                 End With
  31.                 With .Axes(xlValue, xlSecondary) '第2Y座標軸(副座標)
  32.                     .MinimumScale = xMin
  33.                     .MaximumScale = xMax
  34.                     .MaximumScaleIsAuto = True
  35.                     .MajorUnitIsAuto = True
  36.                     .MinorUnitIsAuto = True
  37.                     .Crosses = xlAutomatic
  38.                     .ScaleType = xlLinear
  39.                 End With
  40.             End With
  41.         End With
  42.         Application.ScreenUpdating = True
  43.     End If
  44.    Application.OnTime T + TimeValue("00:01:00"), "GetDDE"               '間隔5分鐘改成TimeValue("00:05:00"),
  45. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 30# slip
請自行依照如下修改
  1. With .Axes(xlValue)             'Y(主)座標軸
  2.                     .MinimumScale = Application.Min(.Parent.Parent.Parent.[I:I])                        '最小值
  3.                     .MaximumScale = Application.Max(.Parent.Parent.Parent.[I:I])                        '最大值
  4.                     .MajorUnitIsAuto = True      '主要刻度間距=自動設定
  5.                     .MinorUnitIsAuto = True      '次要刻度間距=自動設定
  6.                     .Crosses = xlAutomatic       '座標軸與其他座標軸交叉的點=自動設定
  7.                     .ScaleType = xlLinear        '數值座標軸的刻度類型=xlLinear
  8.                 End With
  9.                 With .Axes(xlValue, xlSecondary) 'Y(副)座標軸
  10.                     .MinimumScale = Application.Min(.Parent.Parent.Parent.[J:J])                        '最小值
  11.                     .MaximumScale = Application.Max(.Parent.Parent.Parent.[J:J])                        '最大值
  12.                     .MaximumScaleIsAuto = True
  13.                     .MajorUnitIsAuto = True
  14.                     .MinorUnitIsAuto = True
  15.                     .Crosses = xlAutomatic
  16.                     .ScaleType = xlLinear
  17.                 End With
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 【時間無法遮擋】怕時間消逝,花了許多心血,想盡各式方法要遮擋時間,結果是:浪費了更多時間,且一無所成!
返回列表 上一主題