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之前，AddIn已停用

关于这个声明：

但是，如果我通过数据库登录，则宏不起作用。我不确定，是因为原始工作簿是在某种程度上由excel打开了很短的时间（所以从两个工作簿开始检索数据）或问题在于Application.Wait。我认为Application.Wait不仅会暂停宏，还会阻止公式检索数据。有没有办法暂停宏而不是excel表？

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

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

由于这个公式实际上是一个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

如前所述，我无法测试公式的结果，因为它们指向您的AddIn，但如果提供的工作簿中的公式有效，那么它们也应该与样本完全相同。

从封闭的工作簿中获取公式

1 个答案: