Excel VBA 在函数中加载工作表 [英] Excel VBA Load worksheet in Function
问题描述
我正在尝试编写一个函数来查找外部工作表的第一行.我可以用 sub 来做到这一点,但它不能作为一个函数工作.可以吗.
I am trying to write a function to find the first line of an external worksheet. I can do this with a sub, but it is not working as a function. can it be done.
目前我正在使用
Function GetLine(fileName As String) As Boolean
GetLine = 0
Dim loadBook As Workbook
If loadBook = Application.Workbooks.Open(fileName) Then
GetLine = True
Else
GetLine = False
End If
end function
我收到了#value 的回报.我认为这是因为加载工作簿时出错.
I am getting a return of #value. I think this is because of an error in loading the workbook.
请多多指教,谢谢.
推荐答案
没错,用户定义函数的执行有一定的局限性. 在 UDF 中没有什么技巧可以做你想做的事违反命令.
<强>1.通过后期绑定获取另一个 Excel.Application 实例,用它打开工作簿,通过引用该实例执行所有必要的计算.准确引用创建的实例很重要,这样一些嵌套的 With ... End With
语句或附加语法 e.G.在 .Cells()
之前,.Sheets()
可能看起来不寻常.有一个 UDF 示例如何从关闭的文件中获取工作表上的第一行:
That's right, execution of user-defined functions has certain limitations. There is few tricks to do what you want within UDF and not to violate an order.
1. Get another instance of Excel.Application via late binding, open workbook with it, perform all the necessary calculations by referring to the instance. It's critical to refer exactly to the created instance, so that some nested With ... End With
statements or additional syntax e. g. before .Cells()
, .Sheets()
may seem unusual. There is an UDF example how to obtain the first line on the sheet from the closed file:
Function GetFirstRowLbind(FileName, SheetName) ' UDF function that calculates value, works with certain limitations
On Error Resume Next
With CreateObject("Excel.Application") ' late binding
.Workbooks.Open (FileName)
GetFirstRowLbind = .Sheets(SheetName).UsedRange.Row
.Quit
End With
End Function
OERN
仅用于跳过丢失文件等错误,确保.Quit
语句被执行以防止内存泄漏,否则启动的excel 进程将留在内存中每个工作表重新计算和 UDF 调用.
<强>2.通过将应该在 UDF 完成后执行的操作调度到另一个过程来实现一些 UDF,并根据工作表重新计算事件执行.这种方式更复杂,更难调试,但更灵活,它提供了在 UDF内"执行更多操作的机会,例如更改相邻单元,甚至整个应用程序中的任何可访问数据.调度示例:
将代码放置到 VBAProject 的模块之一:
OERN
used only to skip errors like missing file and others so that .Quit
statement be surely executed to prevent memory leakage, otherwise launched excel processes will stay in memory after each sheet recalc and UDF call.
2. Implement some UDF extending by scheduling to another procedure the actions that should be done after the UDF completion, with execution based on the sheet recalc event. This way more complex and hard to debug, but more flexible and it gives opportunity to do much more "within" UDF, like changing neighbour cells, or even any accessible data in the whole application. Example with scheduling:
Place code to one of the module of VBAProject:
Public Tasks, Permit, Transfer
Function GetFirstRowSched(FileName, SheetName) ' UDF function, schedules filling this UDF cell with a value after all UDFs to be completed
If IsEmpty(Tasks) Then TasksInit
If Permit Then Tasks.Add Application.Caller, Array(FileName, SheetName) ' pack arguments to array, the dictionary key is actually this cell object
GetFirstRowSched = Transfer
End Function
Sub TasksInit() ' function for initial setting values
Set Tasks = CreateObject("Scripting.Dictionary")
Transfer = ""
Permit = True
End Sub
Function GetFirstRowConv(FileName, SheetName) ' function that actually calculates the value, runs without UDF limitations like an usual function
With Application.Workbooks.Open(FileName)
GetFirstRowConv = .Sheets(SheetName).UsedRange.Row
.Close
End With
End Function
将代码放置到 VBAProject 中 Microsoft Excel 对象的 ThisWorkbook 部分:
Private Sub Workbook_SheetCalculate(ByVal Sh As Object) ' sheets recalc event that perform all scheduled calls, puts data to each of UDFs cells
Dim Task, TempFormula
If IsEmpty(Tasks) Then TasksInit
Application.EnableEvents = False
Permit = False
For Each Task In Tasks ' cycle trough all stored cell objects
TempFormula = Task.FormulaR1C1
Transfer = GetFirstRowConv(Tasks(Task)(0), Tasks(Task)(1)) ' unpack arguments from array to perform calculations
Task.FormulaR1C1 = TempFormula
Tasks.Remove Task
Next
Application.EnableEvents = True
Transfer = ""
Permit = True
End Sub
这篇关于Excel VBA 在函数中加载工作表的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!