Éxcel-VBA 在单元格中调用的宏中打开工作簿

Question

我从 Excel 中的单元格调用的函数遇到了一些问题。宏应打开工作簿获取一些数据，然后 return 将数学结果发送到单元格。

但是当我使用下面的代码时，它并没有打开单词本，只是 return #VALUE！到细胞。它在我尝试打开工作簿后立即脱离了代码。

' This Interpolation function is used to get data from other Excel sheets
Public Function DatasheetLookup(ExcelFile As String, ExcelSheet As String, xVal As Double, Optional isSorted As Boolean = True) As Variant
    ' abosolute or relative path?
    If Not (Left(ExcelFile, 3) Like "[A-Z]:\") Or (Left(ExcelFile, 2) = "\") Then
        ExcelFile = ThisWorkbook.path & "\" & ExcelFile
    End If

    ' does file exits?
    If Dir(ExcelFile, vbDirectory) = vbNullString Then
        DatasheetLookup = "No such file!"
        Exit Function
    End If

    ' open the source workbook, read only
    Dim Wbk As Workbook
    Dim WS As Worksheet
'    Application.ScreenUpdating = False ' turn off the screen updating
    Set Wbk = Workbooks.Open(ExcelFile)
       ' Run through all sheets in the source workBook to find "the one"
        For Each WS In Wbk.Worksheets     ' <-- Here it exit the code and return #VALUE!
            If WS.Name <> ExcelSheet Then
                DatasheetLookup = "Sheet not found!"
            Else
                Dim xRange As Range
                Dim yRange As Range
                xRange = WS.Range("A1", "A" & WS.UsedRange.Rows.Count)
                yRange = WS.Range("B1", "B" & WS.UsedRange.Rows.Count)



                Dim yVal As Double
                Dim xBelow As Double, xAbove As Double
                Dim yBelow As Double, yAbove As Double
                Dim testVal As Double
                Dim High As Long, Med As Long, Low As Long

                Low = 1
                High = WS.UsedRange.Rows.Count

                If isSorted Then
                    ' binary search sorted range
                    Do
                        Med = Int((Low + High) \ 2)
                        If (xRange.Cells(Med).Value) < (xVal) Then
                        Low = Med
                        Else
                        High = Med
                        End If
                    Loop Until Abs(High - Low) <= 1
                Else
                    ' search every entry
                    xBelow = -1E+205
                    xAbove = 1E+205

                    For Med = 1 To xRange.Cells.Count
                        testVal = xRange.Cells(Med)
                        If testVal < xVal Then
                            If Abs(xVal - testVal) < Abs(xVal - xBelow) Then
                                Low = Med
                                xBelow = testVal
                            End If
                        Else
                            If Abs(xVal - testVal) < Abs(xVal - xAbove) Then
                                High = Med
                                xAbove = testVal
                            End If
                        End If
                    Next Med
                End If

                xBelow = xRange.Cells(Low): xAbove = xRange.Cells(High)
                yBelow = yRange.Cells(Low): yAbove = yRange.Cells(High)
                DatasheetLookup = yBelow + (xVal - xBelow) * (yAbove - yBelow) / (xAbove - xBelow)
                Exit For
            End If

        Next WS
    Wbk.Close Savechanges:=False
    Set Wbk = Nothing
    Application.ScreenUpdating = True
End Function

Answer 1

我不确定具体原因，但您无法在用户定义的函数中打开文件。还有许多其他操作无法在 Function 中执行。这个 Stack Overflow 答案 here 中也对此进行了讨论。

但是，在您的情况下，您可以通过在调用函数之前打开要读取的文件来轻松绕过此限制。我为此准备了一个非常基本的演示，您需要根据需要修改代码以适合您的特定示例：

"ThisWorkbook"中的代码：

' when the workbook opens, also open the companion spreadsheet so it is available to use
Private Sub Workbook_Open()
    Set Wbk = Workbooks.Open("C:\Users\lrr\Desktop\Myworkbook.xlsx")
End Sub

"Module1"中的代码：

Global Wbk As Workbook

Public Function testFunc()
    ' the workbook is already opened, so you may perform this iteration operation w/o any problems.
    For Each WS In Wbk.Worksheets
        testFunc = 1
        Exit Function
    Next WS
End Function

单元格 A1 中的代码：

=testFunc()

Éxcel-VBA 在单元格中调用的宏中打开工作簿

Éxcel-VBA Open Workbook in macro that have been called in a cell

excel

vba