帖子: 32
主題: 6
精華: 0
積分: 55
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
性別: 女
註冊時間: 2011-4-25
最後登錄: 2011-12-18

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2011-4-25 19:06 | 只看該作者

『發問』新增工作表並同時寫入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! 代碼

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 147
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-6-26

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 2011-4-25 23:29 | 只看該作者

Worksheet_Calculate是工作表事件程序
所以一定是在該工作表模組
P =Cells(6 + j, 1)

學海無涯_不恥下問

TOP

ko310kmo

中學生 Rank: 2

帖子: 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! 代碼

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

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

TOP

ko310kmo

中學生 Rank: 2

帖子: 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! 代碼

TOP