未设置Excel VBA自动筛选对象

时间:2018-03-26 21:59:39

标签: excel vba excel-vba


我有一个宏,在表中确定的列中有用户输入值,将插入一些行,每行都是原始行的填充(用户输入的活动行)。

问题是,宏使用过滤表遇到麻烦,无法将行向上移动。当隐藏列时,并不会完全填满。

所以,使用In Excel VBA, how do I save / restore a user-defined filter?,我想保存过滤器状态,取消过滤并取消隐藏任何列,插入行并恢复过滤器。

我的问题是,我第一次运行宏时它会工作,但是第二次会抛出自动过滤器运行时错误91:对象变量或者没有设置块变量。老实说,我不知道为什么会这样。

我只希望能够插入行,即使表已被过滤,也要从原始行填充所有内容,格式和值。

以下是我的宏:

Public Sub InsertRows(splitVal As Integer, keyCells As Range)

    Call pw
    Call PerformanceUp

    Dim w As Worksheet

    Set w = Worksheets("Orders")

    w.Unprotect Password

    Dim filterArray()
    Dim currentFiltRange As String
    Dim col As Integer

    ' Capture AutoFilter settings - Error starts here after second run
    With w.AutoFilter
        currentFiltRange = .Range.Address
        With .Filters
            ReDim filterArray(1 To .Count, 1 To 3)
            For f = 1 To .Count
                With .Item(f)
                    If .On Then
                        filterArray(f, 1) = .Criteria1
                        If .Operator Then
                            filterArray(f, 2) = .Operator
                        End If
                    End If
                End With
            Next f
        End With
    End With

    'Remove AutoFilter
    w.AutoFilterMode = False
    w.Cells.EntireColumn.Hidden = False

    With keyCells
        On Error GoTo ErrorHandler
        'When filtered, can't paste and insert, so two steps
        .Offset(1).Resize(splitVal).EntireRow.Insert
        .Resize(1 + splitVal).FillDown
    End With

    'Restore Filter settings
    For col = 1 To UBound(filterArray(), 1)
        If Not IsEmpty(filterArray(col, 1)) Then
            If filterArray(col, 2) Then
                w.Range(currentFiltRange).AutoFilter field:=col, _
                Criteria1:=filterArray(col, 1), _
                Operator:=filterArray(col, 2), _
                Criteria2:=filterArray(col, 3)
            Else
                w.Range(currentFiltRange).AutoFilter field:=col, _
                Criteria1:=filterArray(col, 1)
            End If
        End If
    Next col

ExitHandler:
        Call PerformanceDown
        w.Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
        , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
        Exit Sub


ErrorHandler:
        MsgBox Err.Number & ": " & Err.Description, vbOKOnly
        GoTo ExitHandler

End Sub

0 个答案:

没有答案