Excel - 即使在未激活时也会调用用户定义的函数获取

时间:2015-05-12 19:36:54

标签: excel vba excel-vba

我在excel中有一个用户定义的函数。该函数在顶部包含Application.Volatile,效果很好。

我现在遇到的问题是,当我将工作簿打开(让它称为工作簿1)与另一个工作簿(称为工作簿2)时,每次我对工作簿2进行更改时,工作簿1中的所有单元格调用此UDF获得#VALUE!错误。 为什么会这样?

我希望我提供了足够的信息。如果没有,请告诉我。 谢谢 大卫

大家好,感谢您的帮助。 很抱歉......这是代码:

Function getTotalReceived(valCell As Range) As Variant
    Application.Volatile

    If ActiveWorkbook.Name <> "SALES.xlsm" Then Return
    Dim receivedWs As Worksheet, reportWs As Worksheet
    Dim items As Range
    Set reportWs = Worksheets("Report")
    Set receivedWs = Worksheets("Received")

    Dim myItem As String, index As Long
    myItem = valCell.Value
    Set items = receivedWs.Range("A:A")
    index = Application.Match(myItem, items, 0)
    If IsError(index) Then
        Debug.Print ("Error: " & myItem)
        Debug.Print (Err.Description)
        GoTo QuitIt
    End If
    Dim lCol As Long, Qty As Double, mySumRange As Range
    Set mySumRange = receivedWs.Range(index & ":" & index)
    Qty = WorksheetFunction.Sum(mySumRange)
QuitIt:
    getTotalReceived = Qty
End Function

3 个答案:

答案 0 :(得分:2)

您的问题是在UDF中使用ActiveWorkbookActiveWorksheetActiveCell或其他Active_____个对象。请注意,Application.Volitile是应用程序级属性。无论何时切换工作表,书籍,单元格,图表等,相应的“活动”对象都会发生变化。

作为正确的UDF编码实践的一个例子,我把这个简短的例子放在一起:

Function appCallerTest() As String
    Dim callerWorkbook As Workbook
    Dim callerWorksheet As Worksheet
    Dim callerRange As Range

    Application.Volatile True

    Set callerRange = Application.Caller
    Set callerWorksheet = callerRange.Worksheet
    Set callerWorkbook = callerWorksheet.Parent

    appCallerTest = "This formula is in cell: " & callerRange.Address(False, False) & _
                    " in the sheet: " & callerWorksheet.Name & _
                    " in the workbook: " & callerWorkbook.Name
End Function

答案 1 :(得分:1)

You actually have 2 errors in your function. The first was partially addressed by Mr. Mascaro - you need to use the Range reference that was passed to the function to resolve the Workbook that it is from. You can do this by drilling down through the Parent properties.

The second issue is that you are testing to see if Option Explicit Sub EnterWeb() Dim IE As Object Set IE = CreateObject("InternetExplorer.Application") Dim uRl As String Dim UserN As Object 'MSHTML.IHTMLElement Dim PW As Object 'MSHTML.IHTMLElement Dim CoNum As Object 'MSHTML.IHTMLElement Dim AuthCode As Object 'MSHTML.IHTMLElement Dim SUBMIT As Object 'MSHTML.IHTMLElement 'STAGE 1 - LOG INTO THE WEBSITE 'Set the website uRl = "WEBSITE NAME GOES HERE" With IE .navigate uRl .Visible = True End With ' loop until the page finishes loading Do While IE.Busy Loop 'Enter User name in "e-mail" textbox Set UserN = IE.document.getElementByID("email") If Not UserN Is Nothing Then UserN.Value = "TEXT GOES HERE" End If 'Enter Password in "Password" textbox Set PW = IE.document.getElementByID("seccode") If Not PW Is Nothing Then PW.Value = "TEXT GOES HERE" End If 'Sign in to site Dim Item As Object Set Item = IE.document.getElementsByClassName("button positive regular") Item.Item(0).Click 'STAGE 2 -ENTER DETAILS ON NEXT PAGE 'Enter in First textbox 'THIS IS WHERE THE PROBLEM STARTS. 'RUNNING MACRO AUTOMATICALLY GENERATES A RUNTIME ERROR 424 - "OBJECT REQUIRED" 'BUT STEPPING THROUGH USING F8 IT RUNS PERFECTLY Set CoNum = IE.document.getElementByID("PUTS ID HERE") If Not CoNum Is Nothing Then CoNum.Value = "PUTS VALUE HERE" End If 'Enter Code in textbox Set AuthCode = IE.document.getElementByID("PUTS CODE HERE") If Not AuthCode Is Nothing Then AuthCode.Value = "PUTS TEXT HERE" End If End Sub returned a valid Application.Match with the index function. This isn't doing what you think it's doing - IsError checks to see if another cell's function returned an error, not the previous line. In fact, if IsError raises an error, it is in your function so you have to handle it. I believe the error you need to trap is a type mismatch (error 13).

This should resolve both issues:

Application.Match

答案 2 :(得分:1)

Function getTotalReceived(valCell As Range) As Variant
    Application.Volatile

    Dim index, v, Qty

    v = valCell.Value

    'do you really need this here?
    If ActiveWorkbook.Name <> ThisWorkbook.Name Then Exit Function

    If Len(v) > 0 Then

        index = Application.Match(v, _
              ThisWorkbook.Sheets("Report").Range("A:A"), 0)

        If Not IsError(index) Then
            Qty = Application.Sum(ThisWorkbook.Sheets("Received").Rows(index))
        Else
            Qty = "no match"
        End If
    Else
        Qty = ""
    End If

    getTotalReceived = Qty
End Function