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

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) 连接到 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

但是，如果我登录到数据库，宏不起作用。我不确定，是因为原始工作簿在某个级别由 excel 打开一小段时间(因此数据的检索由两个工作簿开始)还是 Application.Wait 的问题。我认为 Application.Wait 不仅会暂停宏，还会阻止公式检索数据。有什么办法可以暂停宏而不是excel表吗？

Answer 1

请验证\纠正我对问题的理解:

一切从一张工作簿开始Sheet1包含在 B 列中的ISIN 列表

程序get_formula用于:

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

湾。输入A1指向驻留在 AddIn 中的 UDF 的公式。这个
公式是从单独的模板工作簿中检索的。

运行程序前get_formula插件已停用

关于这个说法:

However, if I log in by the database the macro does not work. I am not sure, is it because the original workbook is opened by excel at some level for small amount of time (so the retrieving of the data begins by the two workbooks) or the problem is with Application.Wait. I presume that Application.Wait not only pauses the macro but also prevent the formula to retrieve the data. Is it any way to pause the macro but not the excel sheet?

在这方面， Application.Wait Method (Excel)说:

The Wait method suspends all Microsoft Excel activity and may prevent you from performing other operations on your computer while Wait is in effect. However, background processes such as printing and recalculation continue.

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

帖子中的公式之间也存在差异:

=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 已表明模板工作簿中的公式是要使用的公式。

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

它假设保存 ISIN 列表的工作表名为 ISINs (根据需要更改)

它使用相应的 ISIN 为新工作表命名，以便于识别和导航。

它可以选择在更新工作簿之前将计算设置为手动，最后将其设置回用户原始设置。建议以两种方式运行它来测试\验证速度。

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

如前所述，我无法测试指向您的插件的公式的结果，但如果提供的工作簿中的公式有效，那么这些也应该与示例完全相同。