excel - 复制事件行并在下面插入，即使使用事件过滤器

Question

已成功编写代码以插入事件行的 1,3 或 5 行副本 - 在事件行下方。
但是，当过滤器打开时，它不起作用。
我有一张纸
周、员工编号、数据 - 按员工编号排序。
筛选出一名员工。
现在，我想复制我正在标记的行并在下面插入 x 行 - 并“留在事件行上” - 即使我必须做任何体操来删除和添加过滤器......我希望并相信有另一种方式。
我找到了“SpecialCells(xlCellTypeVisible)”，但似乎无法正确放置它 - 它在我的工作表顶部插入了 5 行 :-)
我希望有人可以帮助...我的代码看起来像这样

Sub Insert5Rows()

Dim xcount As Integer
xcount = 5

    ActiveCell.EntireRow.Copy
    Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(xcount, 0)).EntireRow.Insert Shift:=xlDown
    Application.CutCopyMode = False
     
End Sub

提前致谢!!!

Answer 1

事件时插入复制的行自动筛选

我认为不移除过滤器是不可能的(当然不可靠)。

手续getFilterData和 restoreFilters将分别删除和重新应用过滤器。

它肯定没有经过足够的测试，所以要小心。任何反馈都是最受欢迎的。

代码

Option Explicit

Sub insertData()
    
    Const CopiesCount As Long = 5
    
    If TypeName(Selection) <> "Range" Then Exit Sub
    
    Dim ws As Worksheet: Set ws = Selection.Worksheet
    Dim cel As Range: Set cel = Selection.Cells(1)
    Dim rg As Range: Set rg = cel.CurrentRegion
    
    Dim FilterData As Variant
    Dim avoidFilter As Boolean
    If ws.AutoFilterMode Then
        FilterData = getFilterData(rg)
        ws.AutoFilterMode = False
        avoidFilter = True
    End If
    
    With rg.Rows(cel.Row - rg.Row + 1)
        .Copy
        With .Offset(1).Resize(CopiesCount)
            .Insert xlShiftDown
        End With
    End With
    
    If avoidFilter Then
        restoreFilters rg, FilterData
    Else
        Application.CutCopyMode = False
    End If

End Sub

Function getFilterData( _
    ByVal rg As Range) _
As Variant
    With rg.Worksheet.AutoFilter
        With .Filters
            Dim FilterData As Variant: ReDim FilterData(1 To .Count, 1 To 3)
            Dim n As Long
            For n = 1 To .Count
                With .Item(n)
                    If .On Then
                        FilterData(n, 1) = .Criteria1
                        If .Operator Then
                            FilterData(n, 2) = .Operator
                            On Error Resume Next ' Not investigated errors.
                            FilterData(n, 3) = .Criteria2
                            On Error GoTo 0
                        End If
                    End If
                End With
            Next n
        End With
    End With
    getFilterData = FilterData
End Function

Sub restoreFilters( _
        ByRef rg As Range, _
        ByVal BackupData As Variant)
    Dim n As Long
    For n = 1 To UBound(BackupData, 1)
        If Not IsEmpty(BackupData(n, 1)) Then
            If BackupData(n, 2) Then
                rg.AutoFilter Field:=n, Criteria1:=BackupData(n, 1), _
                    Operator:=BackupData(n, 2), Criteria2:=BackupData(n, 3)
            Else
                rg.AutoFilter Field:=n, Criteria1:=BackupData(n, 1)
            End If
        End If
    Next n
End Sub