复制活动行并在下面插入，即使使用活动过滤器 [英] copy active row and insert below even with active filter

问题描述

已成功编写代码以插入活动行的 1,3 或 5 行副本 - 在活动行下方.但是，当过滤器打开时它不起作用.

Have succeeded to make code to insert 1,3 or 5 rows of copies of the active row - below the active row. However it does not work when the filter is on.

我有一张纸周、员工编号、数据 - 按员工编号排序.筛选出一名员工.

I have a sheet with Week, Employee number, data - sorted by employee number. Filtered on one employee.

现在，我想复制我正在标记的行并在下面插入 x 行 - 并留在活动行上"- 即使我必须做任何体操来删除和添加过滤器......我希望并相信还有另一种方法.

Now, I would like to copy the row I am marking and insert x number of rows below - and "stay on the activerow" - even though I have to do whatever gymnastics to remove and add filter... I hope and trust there is another way.

我找到了SpecialCells(xlCellTypeVisible)"；但似乎无法正确放置它 - 它在我的工作表顶部插入了 5 行 :-)

I have found the "SpecialCells(xlCellTypeVisible)" but cannot seem to place it coorectly - it inserted 5 rows in the top of my sheet :-)

希望有人能帮忙...我的代码是这样的

I hope someone can help... My code looks like this

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

先谢谢了！！！

推荐答案

激活时插入复制的行 AutoFilter

• 我认为不移除过滤器是不可能的(肯定不可靠).
• 过程 getFilterData 和 restoreFilters 将分别删除和重新应用过滤器.
• 它肯定没有经过足够的测试，所以要小心.欢迎提供任何反馈.

Insert Copied Rows When Active AutoFilter

• I don't think it is possible (surely not reliable) without removing the filter.
• The procedures getFilterData and restoreFilters will remove and reapply respectively the filters.
• It surely is not tested enough, so take caution. Any feedback is most welcome.

守则

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

这篇关于复制活动行并在下面插入，即使使用活动过滤器的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！