從已關閉的工作簿中獲取公式

Question

我在第一行中有一個包含多個公式的Excel文件。該公式是這樣的：

=TR(Sheet1!B1;"Tr.TPESTValue;TR.TPEstValue.brokername; TR.TPEstValue.date; TR.TPEstValue.analystname;TR.TPEstValue.analystcode";"Curn=EUR SDate=20101106 EDate=20150701 CH=Fd";$B$1) 

這個公式允許通過外接（xlam）連接到互聯網的外部數據庫和用於從該數據庫中檢索數據。 如果我將它們全部放在一個文件中，它們會立刻被運用並且文件崩潰。

因此，我想寫VBA，它將公式複製到其他工作簿和新工作表中，因此等待1或2分鐘，直到上一個工作表中的公式檢索到數據，然後複製下一個公式而不打開我用作公式的「數據庫」的原始文件。

我的代碼，它確實與公式工作（當加載項禁用），如下所示：

Sub get_formula() 

Dim Sheet_i As Worksheet 
Dim o As Excel.Workbook 
Dim raw_i As Long 

For raw_i = 1 To 524 


Set o = GetObject("d:\formulas.xlsx") 
Set Sheet_i = Worksheets.Add(after:=Worksheets(Worksheets.Count)) 
Sheet_i.Cells(1, 1).Formula = o.Worksheets("Sheet1").Cells(raw_i, 1).Formula 
Set o = Nothing ' this ensures that the workbook is closed immediately 


Application.Wait (Now + #00:03:00 AM#) 

Next raw_i 

End Sub 

但是，如果我登錄到數據庫中的宏不起作用。我不確定，是因爲原始工作簿是由excel在某些級別上以少量時間打開的（因此數據的檢索始於兩個工作簿），或者問題出在Application.Wait上。我認爲Application.Wait不僅會暫停宏，還會阻止公式檢索數據。有沒有辦法暫停宏而不是Excel表？

Answer 1

請驗證\糾正我對問題的理解：

1. 所有的工作簿始於一張Sheet1，在B列包含該程序get_formula來的ISINs

2. 列表：

   a。爲每個ISN添加新工作表Sheet1

   b。在A1中輸入指向駐留在AddIn中的UDF的公式。這個公式是從分離的模板工作簿中檢索的。

3. 之前運行的程序get_formula外接程序被禁用

至於這種說法：

但是，如果我通過數據庫中的宏不起作用登錄。我不確定，是因爲原始工作簿是由excel在某些級別上以少量時間打開的（因此數據的檢索始於兩個工作簿），或者問題出在Application.Wait上。我認爲Application.Wait不僅會暫停宏，還會阻止公式檢索數據。有沒有辦法暫停宏而不是Excel表？

在這方面，Application.Wait Method (Excel)說：

等待方法掛起所有的Microsoft Excel活動，可能會阻止 您從您的計算機上執行其他操作的同時等待在 效果。但是，後臺進程（如打印和重新計算）仍在繼續。

由於這個公式實際上是一個UDF，這是可能的，這是不是因爲等待的運行，但我無法測試導致這種不只是計算一個UDF也跑s到數據庫的連接。

也有是在後式之間的差異：

=TR(Sheet1!B1,"Tr.TPESTValue;TR.TPEstValue.brokername; TR.TPEstValue.date; TR.TPEstValue.analystname;TR.TPEstValue.analystcode","Curn=EUR SDate=20101106 EDate=20150701 CH=Fd",$B$1) 

運算表示，從模板工作簿中的公式是：在模板工作簿中公式

=TR('Sheet 1'!C1;'Sheet 1'!$F$1:$F$5;"Frq=D SDate=#1 EDate=#2 Curn=EUR CH=Fd";$B$1;'Sheet 1'!$D$1;'Sheet 1'!$E$1) 

而一個被使用。

此解決方案包含要作爲常量應用的公式，因此不需要打開模板工作簿，因此無需等待。

它假定片保持ISINs列表被命名爲ISINs（如果需要改變）

它的名稱與相應的ISIN新薄板容易identitfication和導航。

它可以在更新工作簿之前將計算設置爲手動，並在最後將其恢復爲用戶原始設置。建議運行它兩種方式來測試\驗證速度。

Sub ISINs_Set_Published() 
'All lines starting with ":" have the purpose of measuring tasks time and printing it in the immediate window 
'They should be commented or deleted after the time assessment is completed 
: Dim dTmeIni As Date 
: Dim dTmeLap As Date 
: Dim dTmeEnd As Date 

Const kISINs As String = "ISINs" 
Const kFml As String = "=TR(kCll," & _ 
    "'Tr.TPESTValue;TR.TPEstValue.brokername; TR.TPEstValue.date; TR.TPEstValue.analystname;TR.TPEstValue.analystcode'," & _ 
    "'Curn=EUR SDate=20101106 EDate=20150701 CH=Fd',$B$1)" 

Dim WshSrc As Worksheet, WshTrg As Worksheet 
Dim rSrc As Range, rCll As Range 
Dim sFml As String 
Dim tCalculation As XlCalculation 

: SendKeys "^g^a{DEL}": Stop 
: dTmeIni = Now: dTmeLap = dTmeIni: dTmeEnd = dTmeIni 
: Debug.Print vbLf; dTmeEnd, Format(dTmeEnd - dTmeLap, "hh:mm:ss"), "Process starts" 

    Rem Application Settings 
    'Change Excel settings to improve speed 
    Application.ScreenUpdating = False 
    Application.EnableEvents = False 
    Application.DisplayAlerts = False 
    tCalculation = Application.Calculation   'To save user setting 
    Application.Calculation = xlCalculationManual 'Set calculation to manual so formulas will not get calculated till end of process 

    Rem Set Range with ISINs 
    With ThisWorkbook.Worksheets(kISINs).Columns(2) 
     Set rSrc = .Cells(2).Resize(-1 + .Cells(.Cells.Count).End(xlUp).Row) 
    End With 

: dTmeEnd = Now 
: Debug.Print vbLf; dTmeEnd, Format(dTmeEnd - dTmeLap, "hh:mm:ss"), , "Loop starts" 
: dTmeLap = dTmeEnd 

    Rem Add ISINs Worksheets 
    For Each rCll In rSrc.Cells 

: dTmeEnd = Now 
: Debug.Print vbLf; dTmeEnd, Format(dTmeEnd - dTmeLap, "hh:mm:ss"), , , "ISIN: "; rCll.Value2 
: dTmeLap = dTmeEnd 

     Rem Refresh Formula 
     With WorksheetFunction 
      sFml = .Substitute(kFml, Chr(39), Chr(34)) 
      sFml = .Substitute(sFml, "kCll", Chr(39) & rCll.Worksheet.Name & Chr(39) & Chr(33) & rCll.Address) 
     End With 

     Rem Add Worksheet 
     With ThisWorkbook 
      On Error Resume Next 
      .Sheets(rCll.Value2).Delete  'Deletes ISIN sheet if present 
      On Error GoTo 0 
      Set WshTrg = .Sheets.Add(After:=.Sheets(.Sheets.Count)) 
     End With 

     Rem Name Worksheet & Set Formula 
     With WshTrg 
      .Name = rCll.Value2 

: dTmeEnd = Now 
: Debug.Print dTmeEnd, Format(dTmeEnd - dTmeLap, "hh:mm:ss"), , , "Set Formula starts" 
: dTmeLap = dTmeEnd 

      .Cells(1).Formula = sFml 

: dTmeEnd = Now 
: Debug.Print dTmeEnd, Format(dTmeEnd - dTmeLap, "hh:mm:ss"), , , "Set Formula ends" 
: dTmeLap = dTmeEnd 

    End With: Next 

: dTmeEnd = Now 
: Debug.Print vbLf; dTmeEnd, Format(dTmeEnd - dTmeLap, "hh:mm:ss"), , "Loop ends" 
: dTmeLap = dTmeEnd 

    Rem Application Settings 
    Application.Goto rSrc.Worksheet.Cells(1), 1 
    Application.ScreenUpdating = True 
    Application.EnableEvents = True 
    Application.DisplayAlerts = True 
    Application.Calculation = tCalculation 

: dTmeEnd = Now 
: Debug.Print vbLf; dTmeEnd, Format(dTmeEnd - dTmeLap, "hh:mm:ss"), , "Application Calculate starts" 
: dTmeLap = dTmeEnd 

    Application.Calculate 

: dTmeEnd = Now 
: Debug.Print dTmeEnd, Format(dTmeEnd - dTmeLap, "hh:mm:ss"), , "Application Calculate ends" 

: Debug.Print vbLf; dTmeEnd, Format(dTmeEnd - dTmeIni, "hh:mm:ss"), "Procedure ends" 

End Sub 

正如前面提到的，因爲它們指向您的AddIn我不能測試公式的結果，但如果提供的工作簿中的公式，然後工作應該這也爲他們的樣品完全相同。