请验证\纠正我对问题的理解:
一切都从一个工作簿开始,其中包含一个工作表 Sheet1,在列 B 中包含 ISIN 列表
-
过程get_formula用于:
一个。为 Sheet1 中的每个 ISN 添加一个新工作表
b.在A1 中输入一个指向驻留在插件中的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 的公式的结果,但如果提供的工作簿中的公式有效,那么这些公式也应该与示例完全相同。