『發問』新增工作表並同時寫入Calculate事件
- 帖子
- 32
- 主題
- 6
- 精華
- 0
- 積分
- 55
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- XP
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2011-4-25
- 最後登錄
- 2011-12-18
|
『發問』新增工作表並同時寫入Calculate事件
本帖最後由 ko310kmo 於 2011-4-26 13:21 編輯
先從網路抓下履約價，並依所需條件篩選後，新增工作表並依剩下的履約價進行重新命名並寫入dde程式(e-leader)，
而每個新增的工作表背後都需要有各自的Calculate
本來是想以程式寫入程式的方式，但我不會改依以下方式進行
複製B活頁簿的Sheet1到Ａ活頁簿，並依A活頁簿的Sheet1的履約價重新命名，有幾個就複製幾個工作表。
＊Ａ活頁簿的一般模組
Sub 下載即時資料()
Dim nRow As Integer
Dim I As Integer
Dim X As Integer
Dim Y As Integer
Dim J As Integer
Dim QryTbl As QueryTable
Dim WebAddress As String
WebAddress = "http://tw.futures.finance.yahoo.com/future/l/opt_TXO_1.html?rr=13022289583560.9952862945437091"
With ThisWorkbook.Worksheets("Sheet1")
.Cells.Clear
Set QryTbl = .QueryTables.Add("URL;" & WebAddress, .Range("A1"))
End With
With QryTbl
.WebTables = "7,8,10"
.WebFormatting = xlWebFormattingNone
.WebSelectionType = xlSpecifiedTables
.RefreshPeriod = 0
.Refresh BackgroundQuery:=False
End With
With ThisWorkbook.Worksheets("Sheet1")
.Columns("B:G").Clear
nRow = .Range("A65536").End(xlUp).Row - 6
.Range(.Cells(nRow + 6 - 15 + 1, 1), .Cells(nRow + 6, 1)).Delete (xlShiftUp)
.Range("a7:a21").Delete (xlShiftUp)
Y = .Range("A65536").End(xlUp).Row
End With
For I = 7 To Y
J = J + 1
X = Worksheets("Sheet1").Cells(I, 1)
Workbooks("B").Worksheets("Sheet1").Copy _
after:=Workbooks("A").Worksheets(1)
ActiveSheet.Name = X
ActiveSheet.Range("H1") = "履約價"
ActiveSheet.Range("H2") = X
ActiveSheet.Range("I1") = "即時成交價"
ActiveSheet.Range("J1") = "歷史成交價"
Select Case Len(ActiveSheet.Range("H2"))
Case Is = 4
ActiveSheet.Range("I2").Formula = "=CATDDE|'FUTOPT<FO>TXO0" & X & "E1'!CurPrice"
Case Is = 5
ActiveSheet.Range("I2").Formula = "=CATDDE|'FUTOPT<FO>TXO" & X & "E1'!CurPrice"
End Select
Next I
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
*B活頁簿的Sheet1背後的程式碼，我寫入
Private Sub Worksheet_Calculate()
Dim Z As Integer
Static Q As Integer
Dim P As Integer
P = Workbooks("A").Worksheets("sheet1").Cells(6 + j, 1)
With ThisWorkbook.Worksheets("" & P & "")
If IsNumeric(.Range("I2").Value) = True Then
Z = .Range("J65536").End(xlUp).Row
.Cells(Z + 1, 10) = .Range("I2")
End If
End With
End Sub
---------------------------------------------------------------------
這樣雖然可以同時複製工作表到Ａ活頁簿並依sheet1的履約價重新命名，但背後的程式碼Calculate的p值都相同，都會是最後一個數值，而不是專屬於自已工作表的沒辦法各自獨立（也就是說8400的工作表的p是8700，8500的工作表也是8700，但我想要的是8400的p是8400），請問該如何改？ |
|
|
50 字節以內
不支持自定義 Discuz! 代碼
|
|
|
|
|
- 帖子
- 32
- 主題
- 6
- 精華
- 0
- 積分
- 55
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- XP
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2011-4-25
- 最後登錄
- 2011-12-18
|
3#
發表於 2011-4-26 13:39
| 只看該作者
回復 2# Hsieh
P = Workbooks("A").Worksheets("sheet1").Cells(6 + j, 1)
指的是A活頁簿的第一欄的數列
改成大大所說的P =Cells(6 + j, 1)
會出現『陣列所引值超出範圍』的錯誤，P會顯示為０
照我發問的寫法，程式可以跑的動，工作表會貼過去並重新命名
但P值卻都會顯示第一個8400
而不會各自顯示其所屬的Ｐ值
我希望的結果－（Ｂ活頁簿Sheet1已事先寫好Calculate事件，複製到A活頁簿
再依A活頁簿的第一欄的數列，依序重新命名，
第一個複製的工作表的P值=8400
第二個複製的工作表的P值=8500
第三個複製的工作表的P值=8600）
我想是否是我的Ｊ的宣告有錯or放的位置有錯
請大大開示，謝謝！！！ |
|
|
50 字節以內
不支持自定義 Discuz! 代碼
|
|
|
|
|
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
4#
發表於 2011-4-26 15:33
| 只看該作者
回復 3# ko310kmo
在A活頁簿的一般模組最頂端,設立公用變數.試試看
Public J As Integer
Sub 下載即時資料()
Dim nRow As Integer
Dim I As Integer
Dim X As Integer
Dim Y As Integer
' Dim J As Integer
Dim QryTbl As QueryTable
Dim WebAddress As String |
|
|
|
|
|
|
|
- 帖子
- 32
- 主題
- 6
- 精華
- 0
- 積分
- 55
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- XP
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2011-4-25
- 最後登錄
- 2011-12-18
|
5#
發表於 2011-4-26 16:41
| 只看該作者
回復 4# GBKEE
如果改成Public J As Integer
P值會變成顯示最後一個9600(最後一個複製的工作表的P值，p最後跑到的那個欄位)
重新命名後的各工作表的Calculate不會各自顯示其所屬的Ｐ值. |
|
|
50 字節以內
不支持自定義 Discuz! 代碼
|
|
|
|
|
