Éxcel-VBA Open Workbook in macro that have been ca

2019-07-24 12:37发布

I have some trouble with a function that I call from a cell in Excel. The macro shall open a workbook get some data and then return a mathematical results to the cell.

But when I use the the following code it does not open the wordbook, just return #VALUE! to the cell. It break out of the code right after I tried to open the workbook.

' 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

1条回答
淡お忘
2楼-- · 2019-07-24 13:09

I am not sure the reason for this specifically, but you cannot open a file in a user defined function. There are many additional actions that cannot be performed in a Function as well. This is also discussed in this Stack Overflow answer here.

However, in your case, you can easily cheat this limitation by opening the file you want to read before you call the function. I prepared a very basic demonstration of this, you will need to modify the code as needed to fit your particular example:

Code in "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

Code in "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

Code in Cell A1:

=testFunc()
查看更多
登录 后发表回答