請教如何將DDE資料貼上sheet2的儲存格

Apple007

請教各位前輩要如何將如圖股票資料,C欄為DDE成交量date,我要將成交量變動大於100張時,貼上sheet2的C3儲存格,第二筆貼上下一列C4,.....依序逐筆往下貼上,如圖所示!請問要如何編寫程式,謝謝~ps.因剛註冊權限尚淺可否請大大貼上來頁面,謝謝!

ashan0418

回復 1# Apple007

將以下貼至Sheet1的物件類別模組中

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     With Target
   
3.         If .Column = 3 And .Value > 100 Then
   
4.                 Target.Offset(, -2).Resize(, 3).Copy Sheets("sheet2").[e65535].End(xlUp).Offset(1, -2)
   
5.         End If
   
6.     End With
   
7. End Sub

複製代碼

Apple007

回復 2# ashan0418
感謝ashan0418大,我現在有一個問題:就是在手動輸入>100時是正常的,但如果盤中透過DDE的資料跳動變動量(>100時),卻不會輸出到sheet2,不知大大是否能有其他解決的方式,可以判斷此種自動資料變動的程式寫法,thank  you!!

ashan0418

回復 3# Apple007


您是指資料是整批匯入的嗎??

Apple007

回復 4# ashan0418
資料是約每十秒即時更新,我excel檔 股票成交量.rar (4.97 KB)

股票成交量
下載次數: 13

2014-12-26 11:22

有dde的連結,安裝這http://www.sinotrade.com.tw/ec/eleader1/setup_eLeader.exe看盤軟體(Testname:B133043133),在盤中C欄的成交量就會變動.

GBKEE

回復 5# Apple007

手動輸入>100時是正常的
會觸動 Worksheet_change(ByVal Target As Range) 工作表有修改事件程式

盤中透過DDE的資料跳動變動量(>100時),儲存格中公式值的變動   
會觸動 Sub Worksheet_Calculate()    工作表有重算事件程式
試試看

1. Dim AR
   
2. Private Sub Worksheet_Calculate()
   
3.     Dim i As Integer
   
4.     i = 2
   
5.     Do While i <= Cells(2, "C").End(xlDown).Row
   
6.         If Not IsError(Cells(i, "C")) Then
   
7.            If Cells(i, "C") > 100 Then
   
8.                 With Sheets("sheet2").[C65535].End(xlUp).Offset(1).Resize(, 3)
   
9.                     If IsEmpty(AR) Then
   
10.                         .Value = Cells(i, "A").Resize(, 3).Value
    
11.                     ElseIf Cells(i, "C") <> AR(i - 1, 1) Then
    
12.                         .Value = Cells(i, "A").Resize(, 3).Value
    
13.                     End If
    
14.                 End With
    
15.             End If
    
16.         End If
    
17.         i = i + 1
    
18.     Loop
    
19.     AR = Range(Cells(2, "C"), Cells(2, "C").End(xlDown))
    
20. End Sub

複製代碼

Apple007

回復 6# GBKEE
GBKEE大您好:我在測試程式時,開啟視窗執行時都會出現如圖執行階段錯誤'13'-型態不符的畫面,將畫面關掉後則可正常執行程式,,不知哪邊出問題,可否請GBKEE大幫我查看看,謝謝!!

GBKEE

回復 7# Apple007
試試看

1. Private Sub Worksheet_Calculate()
   
2.     Dim i As Integer
   
3.     For i = 2 To [C65535].End(xlUp).Row
   
4.         If IsNumeric(Cells(i, "C")) Then
   
5.             If Cells(i, "C") > 100 Then
   
6.                 Sheets("sheet2").[C65535].End(xlUp).Offset(1).Resize(, 3) = Cells(i, "A").Resize(, 3).Value
   
7.             End If
   
8.         End If
   
9.     Next
   
10. End Sub

複製代碼

Apple007

回復 8# GBKEE
GBKEE大大您好:更新碼已無執行階段'13'錯誤問題,但資料變動時會有重複貼資料至sheet2,如圖:

下載 (42.64 KB)

2017-5-26 12:48

請大大在幫我看一下,thanks~

GBKEE

回復 9# Apple007
再試試看

1. Private Sub Worksheet_Calculate()
   
2.     Dim i As Integer
   
3.     For i = 2 To [C65535].End(xlUp).Row
   
4.         If IsNumeric(Cells(i, "C")) Then
   
5.             'C欄為成交量>100 ,D欄為成交總量 > F輔助欄記錄成交總量(**->成交量有變動**)
   
6.             If Cells(i, "C") > 100 And Cells(i, "D") > Cells(i, "F") Then
   
7.                 Cells(i, "F") = Cells(i, "D")  'F輔助欄記錄成交總量
   
8.                 Sheets("sheet2").[C65535].End(xlUp).Offset(1).Resize(, 3) = Cells(i, "A").Resize(, 3).Value
   
9.             End If
   
10.         Else  '為開盤前清理F輔助欄
    
11.             Cells(i, "F") = ""  'F輔助欄記錄成交總量
    
12.         End If
    
13.     Next
    
14. End Sub

複製代碼