Question

我在Excel工作表中有70,000行数据。应用过滤器后，可见行的总数变为40,000。现在我想选择并复制前15,000个可见行。

Answer 1

这对你有用。我建议将其设置为在键盘快捷键上运行。

Const limit As Integer = 15000 

Sub GrabFiltered()
    Dim r As Range
    Dim lr As Range
    Dim tr As Range
    Dim rr As Range
    Dim br As Range
    Dim table As Range
    Dim rows As Integer
    Dim i As Integer
    Dim ct As Integer
    Dim offset As Integer

    Set r = Selection.Cells(1, 1)
    If r.End(xlToLeft).Cells(1, 1).FormulaR1C1 <> "" Then
        Set lr = r.End(xlToLeft).Cells(1, 1)
    Else
        Set lr = r
    End If
    If lr.End(xlUp).Cells(1, 1).FormulaR1C1 <> "" Then
        Set tr = lr.End(xlUp).Cells(1, 1)
    Else
        Set tr = lr
    End If
    If r.End(xlToRight).Cells(1, 1).FormulaR1C1 <> "" Then
        Set rr = r.End(xlToRight).Cells(1, 1)
    Else
        Set rr = r
    End If
    rr.Select
    If rr.End(xlDown).Cells(1, 1).FormulaR1C1 <> "" Then
        Set br = rr.End(xlDown).Cells(1, 1)
    Else
        Set br = r
    End If

    Set table = Range(tr, br)

    'count the number of rows that are visible
    rows = 0
    For i = 1 To table.rows.Count
        If table.Cells(i, 1).Height <> 0 Then
            rows = rows + 1
        End If
    Next

    'limit the number of rows to copy
    If rows > limit Then
        offset = rows - limit
        i = 1
        ct = 1
        While i <> offset
            If br.offset(-ct, 0).Height <> 0 Then
                i = i + 1
            End If
            ct = ct + 1
        Wend
        Set br = br.offset(-ct, 0)
        Set table = Range(tr, br)
    End If

    table.Copy
End Sub

从筛选数据中选择有限数据行

1 个答案: