[已解决]排序后如何取每个排序的前两行

hhaa999

pb1us0E9.rar (8.18 KB, 下载次数: 1)

2010-5-20 14:39 上传

点击文件名下载附件
排序后如何取每个排序的前两行

最佳答案

月排行榜 / 总排行榜

amulee

2010-5-20 14:59

Sub pmc()
    Dim i&, ArrYS, ArrJG, K&, j%, Ct&
    Application.ScreenUpdating = False
    ArrYS = Sheet1.Range("A2:C" & Sheet1.[a65536].End(xlUp).Row)
    [E2:G10000].Clear
    ReDim ArrJG(1 To 3, 1 To 1)
    K = 1
    Ct = 1
    For j = 1 To 3
        ArrJG(j, 1) = ArrYS(1, j)
    Next j
    For i = 2 To UBound(ArrYS)
        If ArrYS(i, 3) = ArrYS(i - 1, 3) Then
            Ct = Ct + 1
        Else
            Ct = 1
        End If
        If Ct < 3 Then
            K = K + 1
            ReDim Preserve ArrJG(1 To 3, 1 To K)
            For j = 1 To 3
                ArrJG(j, K) = ArrYS(i, j)
            Next j
        End If
    Next i
    Range("E2").Resize(UBound(ArrJG, 2), 3) = Application.Transpose(ArrJG)
    Application.ScreenUpdating = True
End Sub

跳转到最佳答案楼层

amulee

Sub pmc()
    Dim i&, ArrYS, ArrJG, K&, j%, Ct&
    Application.ScreenUpdating = False
    ArrYS = Sheet1.Range("A2:C" & Sheet1.[a65536].End(xlUp).Row)
    [E2:G10000].Clear
    ReDim ArrJG(1 To 3, 1 To 1)
    K = 1
    Ct = 1
    For j = 1 To 3
        ArrJG(j, 1) = ArrYS(1, j)
    Next j
    For i = 2 To UBound(ArrYS)
        If ArrYS(i, 3) = ArrYS(i - 1, 3) Then
            Ct = Ct + 1
        Else
            Ct = 1
        End If
        If Ct < 3 Then
            K = K + 1
            ReDim Preserve ArrJG(1 To 3, 1 To K)
            For j = 1 To 3
                ArrJG(j, K) = ArrYS(i, j)
            Next j
        End If
    Next i
    Range("E2").Resize(UBound(ArrJG, 2), 3) = Application.Transpose(ArrJG)
    Application.ScreenUpdating = True
End Sub