范围从最后160行中选择

Question

我有一个筛选表，我想从中复制最后160个条目。我过滤表的代码运行良好，但下面的代码复制了整个160行。我需要从B列到S列的最后160行。此外，我可以选择最后筛选的160行（之前使用特定条件筛选），而不是实际的最后160列吗？根据示例：最后160行可能包含90到100的行号以及其他标准。

谢谢你的帮助。我的代码如下：

Sub FilterRows()
Dim LastRow As Long, x As Long
LastRow = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
x = 160
Range(LastRow - x + 1 & ":" & LastRow).Copy
End Sub

Answer 1

这将复制最后160行可见数据的单元格B:S。

Sub CopyLastXNumberVisibleRows()
    Const MaxRows = 160
    Dim count As Long, lastRow As Long, x As Long
    Dim SourceRange As Range
    lastRow = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    For x = lastRow To 2 Step -1
        If Not Rows(x).Hidden And Cells(x,"A") = "Some Criteria" Then
            count = count + 1
            If SourceRange Is Nothing Then
                Set SourceRange = Range(Cells(x, "B"), Cells(x, "S"))
            Else
                Set SourceRange = Union(SourceRange, Range(Cells(x, "B"), Cells(x, "S")))
            End If
            If count = MaxRows Then Exit For
        End If
    Next
    If Not SourceRange Is Nothing Then
        SourceRange.Copy Destination:=Sheet1.Range("A2")
    End If
End Sub

Answer 2

您可以用另一种方式思考。只需将所有过滤后的数据复制到新的工作表中，然后使用do while循环删除多余的数据。

Sub LastRows()
Dim row As Integer
Sheets.Add after:=Sheets(Sheets.Count)
Sheets("Sheet1").Cells(1, 1).CurrentRegion.Copy ActiveSheet.Cells(1, 1) 
row = Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Rows.Count
If row > 161 Then 'including the title
    Rows("2:" & (row - 160)).Delete
End If
End Sub

请将"Sheet1"更改为数据表的名称

Answer 3

您可以使用这样一个函数：

Function FilteredRows(nRowsToCopy As Long, rng As Range, firstCol As String, lastCol As String) As Range
    Dim firstRow As Long: firstRow = 2
    With rng
        With .Offset(1, .Parent.UsedRange.Columns.Count).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Offset(, .Parent.UsedRange.Columns.Count)
            .FormulaR1C1 = "=max(R1C:R[-1]C)+1"
            If WorksheetFunction.Max(.Cells) > nRowsToCopy Then firstRow = .Find(what:=WorksheetFunction.Max(.Cells) - nRowsToCopy + 1, lookat:=xlWhole, LookIn:=xlValues).Row
            .Clear
        End With
        Set FilteredRows = Intersect(.SpecialCells(xlCellTypeVisible), .Parent.Columns(firstCol & ":" & lastCol), .Parent.Rows(firstRow).Resize(.Rows(.Rows.Count).Row - firstRow + 1))
    End With
End Function

在你的主要代码中被利用，如下所示：

FilteredRows(nRowsToCopy, dataRng, "B", "S").Copy

其中

• nRowsToCopy是要复制的最后筛选的行数（最大）
• datarng是包含所有数据（包括标题）的范围
• "B"和"S"是要复制的第一列和最后一列

Answer 4

您必须调整要将输出复制到的位置，但请在下面尝试，使用代码Cells(1, 1) 的这一部分

Sub test()
   Sheets("Sheet1").Cells(2, 14).Resize(160, 17).Value = Cells(Cells(Rows.Count, _
                2).End(xlUp).Row - 159, 2).Resize(160, 17).Value
End Sub