从封闭的工作簿获取公式

我有第一行中有几个公式的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）连接到Internet中的外部数据库，并用于从此数据库中检索数据。 如果我把它们都放在一个文件中，就立刻行使它，并将文件崩溃。

所以我想写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 

但是，如果我login到数据库macros不起作用。 我不太清楚，是不是因为原来的工作簿在某个层次上以less量的时间打开（所以数据的检索是由两个工作簿开始的），还是问题与Application.Wait有关。 我认为Application.Wait不仅会暂停macros，还会阻止公式检索数据。 有没有办法暂停macros而不是Excel表？

Answer 1

请validation\纠正我对这个问题的理解：

1. 所有这些工作都是从工作簿开始的，工作表Sheet1有一张Sheet1 ， B列中包含ISIN列表

2. 过程get_formula用于：

   一个。 为Sheet1每个ISN添加一个新的工作表

   湾 在A1input一个指向AddIn中驻留的UDF的公式。 此公式从分离的模板工作簿中检索。

3. 在运行程序get_formula之前，AddIn被禁用

关于这一说法：

但是，如果我login数据库macros不起作用。 我不太清楚，是不是因为原来的工作簿在某个层次上以less量的时间打开（所以数据的检索是由两个工作簿开始的），还是问题出在Application.Wait上。 我认为Application.Wait不仅会暂停macros，还会阻止公式检索数据。 有没有办法暂停macros而不是Excel表？

在这方面， Application.Wait方法（Excel）说：

等待方法暂停所有Microsoft Excel活动，并可能会阻止您执行其他操作时您的计算机上等待有效。 但是，后台进程（如打印和重新计算）仍在继续。

由于这个公式实际上是一个UDF，有可能是因为等待而没有运行，但是我不能testing这个原因，这不仅仅是一个UDF的计算，而且还运行一个数据库连接。

另外这个post中的公式也有差异：

 =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) 

和模板工作簿中的公式：

 =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) 

Op表示，模板工作簿中的公式是要使用的公式。

此解决scheme包含要作为常量应用的公式，因此不需要打开模板工作簿，因此无需等待。

它假设持有ISIN列表的表被命名为ISINs （如果需要，则更改）

它用相应的ISIN命名新的纸张，以便于识别和导航。

在更新工作簿之前，可以select将计算设置为手动，最后将其设置回用户原始设置。 build议运行它两种方式来testing\validation速度。

 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 

如前所述，我不能testing公式的结果，因为它们指向您的AddIn，但是如果工作簿中提供的公式正在工作，那么这些公式也应该与样本完全相同。