从已关闭的工作簿中获取公式

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我不能测试公式的结果，但如果提供的工作簿中的公式，然后工作应该这也为他们的样品完全相同。