【问题标题】:Get formulas from closed workbook从关闭的工作簿中获取公式
【发布时间】:2016-02-07 20:15:10
【问题描述】:

我有一个 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表吗?

【问题讨论】:

  • 也许将Calculate作为一行放在application.wait之上可以确保Excel的数据刷新在等待之前完全发生?
  • 感谢您的建议,我会尝试并报告,它的工作原理。
  • 这些公式是固定的还是不断变化的。如果它们是固定的,我建议在程序(即宏)中使用公式并根据需要应用它们(无需继续从“模板”文件中检索它们,检索将始终相同的东西有什么意义. 即使公式被更改,您也可以有一个过程从“模板”文件中读取公式,因为它们会在更新时重写到过程中......
  • @ Grade 'Eh' Bacon 如果将计算方法应用于单元格Sheet_i.Cells(1, 1).Calculate 并且应用为Application.Calculate.
  • @EEM 公式确实发生了变化,它们每次都引用不同的股票 ID,我保存在 Sheet1 中。我试图在循环中生成公式,但它已完成,因为公式中有 . ;(非 EN excel),我必须考虑正则表达式。我仍然认为这里最大的问题是找到Application.Wait 的替代方案,这可以让我推迟循环并检索数据。

标签: vba excel


【解决方案1】:

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

  1. 一切都从一个工作簿开始,其中包含一个工作表 Sheet1,在列 B 中包含 ISIN 列表

  2. 过程get_formula用于:

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

    b.在A1 中输入一个指向驻留在插件中的UDF 的公式。这 公式是从单独的模板工作簿中检索的。

  3. 在运行过程 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 的公式的结果,但如果提供的工作簿中的公式有效,那么这些公式也应该与示例完全相同。

【讨论】:

  • 感谢您的帮助。您对任务的描述是正确的。该代码运行良好。它在宏中生成公式并将其粘贴到新工作表中。但是Application.Calculation = xlCalculationManual 不会阻止所有公式一次执行。也许您还有其他想法如何解决这个问题,从而解决宏?
  • 很高兴帮助解决这个问题,如果您通过选择它来确认答案,我们将不胜感激,这也将有助于保持网站的更新。您是否测量了手动和自动两种模式之间的时间。我将插入一些行来帮助您进行测量。我们需要评估延迟是否可以接受或太大,毕竟要记住计算取决于插件和与数据库的连接。您是否可以在宏完成后测量计算时间?因此可以确定运行宏时所花费的额外时间。
  • 我将手动和自动两种模式的时间测量结果的链接发布到私人聊天中。
猜你喜欢
  • 2012-03-04
  • 2013-06-03
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2015-01-18
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多