『發問』新增工作表並同時寫入Calculate事件

ko310kmo

先從網路抓下履約價，並依所需條件篩選後，新增工作表並依剩下的履約價進行重新命名並寫入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），請問該如何改？

Hsieh

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

ko310kmo

回復 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放的位置有錯
請大大開示，謝謝！！！

GBKEE

回復 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

ko310kmo

回復 4# GBKEE
如果改成Public J As Integer

P值會變成顯示最後一個9600(最後一個複製的工作表的P值，p最後跑到的那個欄位)
重新命名後的各工作表的Calculate不會各自顯示其所屬的Ｐ值.