复制活动行,并使用活动过滤器插入下方 [英] 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
预先感谢一堆!!!
推荐答案
在活动时插入复制的行自动过滤
- 我认为不卸下过滤器就不可能(肯定不可靠).
-
getFilterData
和restoreFilters
过程将分别删除并重新应用过滤器. - 它肯定没有经过足够的测试,因此请小心.任何反馈都是最欢迎的.
- I don't think it is possible (surely not reliable) without removing the filter.
- The procedures
getFilterData
andrestoreFilters
will remove and reapply respectively the filters. - It surely is not tested enough, so take caution. Any feedback is most welcome.
Insert Copied Rows When Active AutoFilter
代码
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屋!