Question

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

但是当我使用下面的代码时，它不会打开wordbook，只返回#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在宏中打开的工作簿已在单元格中调用

1 个答案: