Question

有人知道如何在此之后仅获取前100个结果行：

=COUNTIFS(R2C9:R50000C9,RC[-1])>30？

这是我的代码，我记录了它。

提前谢谢你。我希望有人帮助我。

Sub philoly_3()
'
' philoly_3 Macro
'

    Sheets("Graph data").Select
    Range("J1").Select
    Selection.NumberFormat = "0.00"
    ActiveCell.FormulaR1C1 = "Criteria"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=COUNTIFS(R2C9:R50000C9,RC[-1])>30"
    Range("J2").Select
    Selection.AutoFill Destination:=Range("J2:J50000")
    Range("J2:J50000").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Style = "Input"
    Range("F2").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$J$50000").AutoFilter Field:=10, Criteria1:="TRUE"
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range("A1:I1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("All moments").Select
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("F2").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
    Sheets("All moments").Select
    Application.CutCopyMode = False
    Sheets("All moments").Move Before:=Sheets(1)
    Sheets("Graph data").Select
    ActiveSheet.Range("$A$1:$J$50000").AutoFilter Field:=10
    Range("I50000").Select
    Selection.End(xlUp).Select
    Range("I2").Select
    Selection.AutoFilter
    Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    Range("B2").Select

    philoly_11

End Sub

Answer 1

也许这可以帮到你。只需修改您的需求并在您的代码中实现它。为此，我的数据范围为=B2:E481。我的标准是/否在E栏中。我复制了E列中为“是”的前100个范围（B：D），并将它们粘贴到Z2中。

Sub COPY_100_FIRST_YES()
Dim i As Byte
Dim MyRanges As String
Dim MyYesRanges() As String
Dim MyFinalSelection As Range

Range("E2").Select 'first row of my YES/NO column
i = 0
Do Until ActiveCell.Value = "" Or i = 100 'Loop until you have 100 yes or there is no more data
    If ActiveCell.Value = "yes" Then
        i = i + 1
        If MyRanges = "" Then
            MyRanges = ActiveCell.Row
        Else
            MyRanges = MyRanges & "||" & ActiveCell.Row
        End If
    End If
    ActiveCell.Offset(1, 0).Select
Loop

 'Now I have all rows that are YES and I know the columns i want to copy, in my case is columns B to D, so

 MyYesRanges() = Split(MyRanges, "||")

 For i = 0 To UBound(MyYesRanges) Step 1
    If i = 0 Then
        Set MyFinalSelection = Range("B" & MyYesRanges(i) & ":D" & MyYesRanges(i))
    Else
        Set MyFinalSelection = Application.Union(MyFinalSelection, Range("B" & MyYesRanges(i) & ":D" & MyYesRanges(i)))
    End If
 Next i


MyFinalSelection.Copy

'Paste where you want them
Range("Z2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End Sub

在将特定条件应用于我的表后，复制前100个结果行

1 个答案: