Excel VBA 错误取决于列的过滤方式

Question

我有一个从单元格 C1 调用的便捷函数，该函数使用过滤器下拉列表中已应用于 C 列的过滤器填充单元格:=ShowColumnFilter(C:C)只要用户在下拉列表中单击“确定”，单元格就会显示过滤器。
但是，当我从命令按钮或超链接使用下面的 VBA 将过滤器应用于同一列时，该列已正确过滤，但函数 ShowColumnFilter 返回错误。

'Code Snippet:
With ActiveSheet.Range("A:W")

    .AutoFilter Field:=3, Criteria1:="Some Criteria Here"

End With

Function ShowColumnFilter(rng as Range)   

'Only the relevant code included here. Works fine when filtering through dropdown, but gives error after applying filter through the VBA in Worksheet_FollowHyperlink.

     Dim sh As Worksheet
     Dim frng As Range
     
     Set sh = rng.Parent

     Debug.Print sh.FilterMode          
     'When filtered from UI dropdown OR after executing VBA Code Snippet from Worksheet_FollowHyperlink returns TRUE

     Debug.Print sh.AutoFilter.FilterMode         
     'When filtered from UI dropdown returns TRUE but after executing VBA from hyperlink or command button creates an error: "Object variable or With block variable not set"
    
    Set frng = sh.AutoFilter.Range       'Errors only after  filtering by executing VBA from separate routine
    ...
End Function

这让我感到困惑，因为函数 ShowColumnFilter 正在填充一个单元格，而不是由另一个 sub 直接调用。我正在尝试使用已应用于列的过滤填充 C1，而不管用户如何过滤它。任何帮助是极大的赞赏。
完整代码在这里:

Function ShowColumnFilter(rng As Range)
On Error GoTo myErr
'> PURPOSE: Show filters used in a specific column _
   USAGE:   =ShowColumnFilter(C:C)
   
    Dim filt As Filter
    Dim sCrit1 As String
    Dim sCrit2 As String
    Dim sOp As String
    Dim lngOp As Long
    Dim lngOff As Long
    Dim frng As Range
    Dim sh As Worksheet
    Dim i As Long
 
    Set sh = rng.Parent
    
    If sh.FilterMode = False Then
        ShowColumnFilter = "No Active Filter"
        Exit Function
    End If
    
    '**** Included only for debugging *****
    Debug.Print sh.FilterMode
    Debug.Print sh.AutoFilter.FilterMode
    '**************************************
    
    Set frng = sh.AutoFilter.Range
 
    If Intersect(rng.EntireColumn, frng) Is Nothing Then
        ShowColumnFilter = CVErr(xlErrRef)
    Else
        lngOff = rng.Column - frng.Columns(1).Column + 1
        If Not sh.AutoFilter.Filters(lngOff).On Then
            ShowColumnFilter = "No Conditions"
        Else
            Set filt = sh.AutoFilter.Filters(lngOff)
            On Error Resume Next
            lngOp = filt.Operator
            If lngOp = xlFilterValues Then
            
                For i = LBound(filt.Criteria1) To UBound(filt.Criteria1)
                    sCrit1 = sCrit1 & filt.Criteria1(i) & " or "
                Next i
                sCrit1 = Left(sCrit1, Len(sCrit1) - 3)
            Else
            
                sCrit1 = filt.Criteria1
                sCrit2 = filt.Criteria2
                If lngOp = xlAnd Then
                    sOp = " And "
                ElseIf lngOp = xlOr Then
                    sOp = " or "
                Else
                    sOp = ""
                End If
            End If
            ShowColumnFilter = sCrit1 & sOp & sCrit2
        End If
    End If
    
myExit:
    Exit Function
myErr:
    Call ErrorLog(Err.Description, Err.Number, "GlobalCode", "ShowColumnFilter", True)
    Resume myExit
End Function

Sub ErrorLog(strErrDescription As String, lngErrNumber As Long, strSheet As String, strSubName As String, bolShowError As Boolean)
On Error GoTo myErr
'> PURPOSE: Record Errors in an Error Log

    If bolShowError = True Then _
        MsgBox "An error has occured running " & strSubName & " on worksheet " & strSheet & ": " & Err.Number & " - " & Err.Description, vbInformation, "VBA Error"

myExit:
    Exit Sub
myErr:
    MsgBox "VBA Error - Error Log: " & Err.Number & " - " & Err.Description
    Resume myExit
End Sub

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
On Error GoTo myErr
'> PURPOSE: Fires whenever a hyperlink is clicked on Sheet 1

Dim sValue as String

sValue = "Some Useful Criteria"

     '> Select the sheet:
     Sheets("MySheetName").Select
        
     With ActiveSheet.Range("A:W")
                
            If Len(sValue) > 0 Then _
                .AutoFilter Field:=3, Criteria1:=sValue
            
     End With
        
     '> Go to the top row:
     ActiveWindow.ScrollRow = 1
    
myExit:
    Exit Sub
myErr:
    Call ErrorLog(Err.Description, Err.Number, "Sheet1", "FollowHyperlink", True)
    Resume myExit
End Sub

Answer 1

看起来您遇到的问题与您的 ShowColumnFilter 的确切时间有关。功能正在运行。作为 UDF，它在重新计算工作表时执行。申请 AutoFilter开始重新计算。因此，如果您在 Worksheet_FollowHyperlink 中捕获调用堆栈例程，您可以检测到 ShowColumnFilter函数输入立即关注 .AutoFilter Field:=3, Criteria1:=sValue陈述。因此，您的函数实际上是在某种未知状态下捕获工作表和过滤器。
我可以通过禁用事件和自动计算来保护那段代码来解决这个问题:

Sub ApplyTestFilter()
    'Hyperlink Code Snippet:
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    With ActiveSheet.Range("A:W")
        .AutoFilter Field:=2, Criteria1:=">500"
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

这会强制自动计算延迟，直到您完成过滤。 (注意:在某些情况下，您可能必须明确强制工作表重新计算，尽管我在小测试中没有遇到这种情况。)