获取Top10值，而无需重复类别列中的任何项目

Question

我想要实现的是使用column(Q)= NumFab作为参数来获取列（P）中每个客户端的前十个值。然后在新表Order中列出找到的Client，NumbFab和=range("B26: B35")的号码。限制是发现后不能重复客户端。

我的部分代码如下，我现在已经死胡同了，感谢您的支持

    Sub FindTop10()
 Dim rngDatos As Range
 Dim lNumEntradas As Long
 Dim dOriginal As Variant
 Dim Celda As Range
 Dim RtopTen As Range

     Set rngDatos = h_Calc.Range("o4", h_Calc.Cells(Rows.Count, "x").End(xlUp))

     dOriginal = rngDatos 'save data original

     'set off notifications
     With Application
        lCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
     End With
     'if there is a problem set apps back
     On Error GoTo CleanExit
        With h_Calc
            rngDatos.Sort key1:=Range("x4"), Order1:=xlDescending, Header:=xlGuess
        End With

        ultLinea = h_Calc.Cells(Rows.Count, "o").End(xlUp).Row

        h_Calc.Range("b26:d35").Clear

        Set RtopTen = h_Calc.Range("C26:C35")
    With h_Calc


        i = 4
        For Each Celda In RtopTen

            Do Until Celda.Value = .Cells(i, "P").Value
                Celda.Offset(0, -1) = .Cells(i, "o").Value
                Celda = Format(.Cells(i, "p"), "@")
                Celda.Offset(0, 1) = .Cells(i, "Q").Value
            Loop

        Next Celda

    End With

End Sub

Answer 1

我认为获得前10名订单最简单的方法，这看起来很奇怪，有意触发错误，这是我用来在列中查找唯一值的以下代码，我添加了一条规定来停止在10次迭代中。您对大多数订单进行排序后，便会出现此代码。

Dim i As Long, lr1 As Long, lr2 As Long
With Sheets("Source")
    lr1 = .Cells(Rows.Count, 4).End(xlUp).Row
End With
With Sheets("Destination")
    For i = 2 To lr1
        If lr2 = 12 Then Exit Sub 'assumes header in row 1 and you want to count from 2~11
        lr2 = .Cells(Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
        If Application.Match(Sheets("Source").Cells(i, 4), .Range(.Cells(1, 1), .Cells(lr2, 1)), 0) > lr2 Then .Cells(lr2 + 1, 1).Value = Sheets("Source").Cells(i, 4).Value
    Next i
End With

尽管您可以编辑以使用范围，但这将只占用一个数据点。