实现具有大量BDH单元格引用的彭博时间延迟

Question

我已经看过几个如何使用Application.OnTime， 在更新之前检查单元格内的进度并编写实现的例子，但我不知道为什么它不会工作。 我不想在这里粘贴整个东西，因为它可能比只看工作簿中的潜艇更容易混淆。

我在想，如果有这方面的经验的人愿意看我的代码。我可以下载我正在处理的文件。

以下是将数据加载到shell表单的方法。理想情况下，数据将在pattern_recogADR子版运行之前全部加载......否则会出现错误。

Sub build_singleEquity() 

'x As Long 

Dim x As Long 
x = 6 


'Dim x As Long 
'x = 4 

Application.ScreenUpdating = False 
Call DefineTixCollection 'creates table of inputs 
'check 
'Debug.Print TixCollection(4).ORD 

'set up data points - from "Input" sheet 
'Dim x As Long 
'Dim path As String 
'path = Sheets("Input").Range("V1").value 

'For x = 1 To TixCollection.Count 

    Sheets("SingleEquityHistoryHedge").Activate 

    'clear inputs 
    Range("B2:B8").Clear 

    Dim Inputs() As Variant 
    Dim name As String 

    name = "SingleEquityHistoryHedge" 

    'insert new inputs 

     Inputs = Array(TixCollection(x).ADR, TixCollection(x).ORD, TixCollection(x).ratio, _ 
     TixCollection(x).crrncy, TixCollection(x).hedge_index, TixCollection(x).hedge_ord, _ 
     TixCollection(x).hedge_ratio) 
     Call PrintArray(2, 2, Inputs, name, "yes") ' prints inputs 

    Dim last_row As Long 
    last_row = Range("A" & Rows.count).End(xlUp).Row 

    Range("AN11") = "USD" & TixCollection(x).crrncy 
    Range("AA11") = "USD" & TixCollection(x).crrncy 

' Dim sht_name As String 

'Application.Run "RefreshAllStaticData" 

BloombergUI.ThisWorkbook.RefreshAll 

' sht_name = TixCollection(x).ADR 

    ' Call Sheet_SaveAs(path, sht_name, "SingleEquityHistoryHedge") 'save collection of sheets 

'Next x 

'Call TriggerCalc 



'check this out 
Call pattern_recogADR(x + 4, 5, 13) 


End Sub 

这里是pattern_recogADR子....你可以看到我已经尝试了一吨的被注释掉了不同的事情。

Sub pattern_recogADR(pos As Long, pat_days As Long, sht_start As Long) 

' 

'Application.Wait Now + "00:00:20" 

'Dim pat As pattern 

'Dim tix As clsTix 

Dim newTime As Date 
newTime = Now + TimeValue("00:00:30") 

Do While Not Now >= newTime 
'add back in as parameters 
'Dim pos As Long 
Dim x As Long 
'Dim pat_days As Long 
'Dim sht_start As Long 
'************************ 
'pos = 5 
'pat_days = 5 
'sht_start = 13 

Sheets("SingleEquityHistoryHedge").Activate 
'Sleep 20000 'sleeps 


Dim st As Long 
Dim st_num As Long 
Dim st_end As Long 
Dim count As Long 
Dim patrn As Long 


count = sht_start 

Dim i As Long 
Dim j As Long 
Dim patPLUSret() As Variant 
Dim k As Long 
Dim z As Long 


k = 2 
z = 3 

For j = 8 To 12 


'************************************** 
    count = sht_start 
    st_num = sht_start 
    st_end = 13 


     If IsNumeric(Cells(count, j).value) Then 
       'sets default pattern to beginning cell value 

       ' Debug.Print st_num 


       If Cells(st_num, j).value < 0 Then 
        For i = count + 1 To count + 1 + pat_days 
         If IsNumeric(Cells(i, j).value) Then 
          If Cells(i, j).value < 0 Then 
          st_end = i 
          'Debug.Print st_end 
          End If 
         Else 
          Exit For 


         End If 
        Next i 

         patrn = st_end - st_num 

         ' Debug.Print count 
         ' Debug.Print patrn 

         ReDim Preserve patPLUSret(k * 2 + 1) 
         patPLUSret(0) = Range("B2").value 'ADR 
         patPLUSret(1) = Range("B3").value 'ORD 
         patPLUSret(k) = patrn 
         patPLUSret(z) = Application.WorksheetFunction.Average(Range(Cells(st_num, j), Cells(st_end, j))) 

        ' Debug.Print patPLUSret(j) 
        ' Debug.Print patPLUSret(j + 1) 

         st_num = sht_start 'resets starting point to initial 
         st_end = sht_start 



         ' For x = 4 To 6 
         '  If Range("L" & x).value = "x" Then 
         '  ReDim Preserve mac_array(x - 4) 
         '  mac_array(x - 4) = Range("N" & x).value 
         '  End If 
         ' Next x 


         ' check this out 
         'tix.arbPnl = patrn 
         'save to separate class for patterns 
         'TixCollection.Add tix, tix.ADR 
         '****************************** 


       ElseIf Cells(st_num, j).value > 0 Then 
        For i = count + 1 To count + 1 + pat_days 
         If IsNumeric(Cells(i, j).value) Then 
          If Cells(i, j).value > 0 Then 
           st_end = i 
          End If 
         Else 
          st_end = st_num 
          Exit For 
         End If 
        Next i 

         patrn = st_end - st_num 

         ReDim Preserve patPLUSret(k * 2 + 1) 
         patPLUSret(0) = Range("B2").value 'ADR 
         patPLUSret(1) = Range("B3").value 'ORD 
         patPLUSret(k) = patrn 
         patPLUSret(z) = Application.WorksheetFunction.Average(Range(Cells(st_num, j), Cells(st_end, j))) 

         ' Debug.Print patPLUSret(j) 
         ' Debug.Print patPLUSret(j + 1) 


         st_num = sht_start 'resets starting point to initial 
         st_end = sht_start 

         ' Debug.Print patrn 

         'pat.arbPnl = patrn 
         'save to separate class for patterns 
       End If 


       k = k + 2 
       z = z + 2 
     Else 
      count = count + 1 
      st_num = count 
     End If 

    ' 
    ' k = k + 1 

     'new_array = patPLUSret 


Next j 

    ' Debug.Print patPLUSret 

    Sheets("PatternADR_ORD").Activate 
    Range(Cells(pos, 1), Cells(pos, 10)) = patPLUSret 


Loop 


End Sub 

Answer 1

如果您等待或循环模拟第二个子项中的等待，它将不会将控件返回到电子表格并且您的公式不会更新。

而不是

Call pattern_recogADR(x + 4, 5, 13) 

你为什么不打电话：

Application.onTime "'pattern_recogADR ""x + 4"", ""5"", ""13""'"