Ранжируйте значения столбца в другом столбце

Question

Я знаю, что эта строка неверна:

ws.Cells(i, "D").Resize(39).Rank_Eq(2, "2:40", 1) = ws.Cells(Rows.Count, "E").End(xlUp).Offset(1, 0)

Я хочу ранжировать весь столбец D в столбце E. Числа должны быть «сгруппированы» по 39 числам.

Private Sub CommandButton2_Click()
Dim lrow As Long
Dim i As Long

Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets("Sheet1") 'Set the name of the sheet

lrow = ws.Cells(Rows.Count, "D").End(xlUp).row  'Find the last row in column D
For i = 2 To lrow Step 39 'Loop every group (group of 13 rows) in column D
    ws.Cells(i, "D").Resize(39).Rank_Eq(2, "2:40", 1) = ws.Cells(Rows.Count, "E").End(xlUp).Offset(1, 0)
Next i

End Sub

введите описание изображения здесь

Answer 1

Думаю, код сделает то, что вы хотите. Обратите внимание на константы вверху, которые вы должны установить в соответствии с вашими потребностями.

1. FirstDataRow - ваши данные, похоже, начинаются со строки 2. Так что не меняйте.
2. GroupSize - Я тестировал группы по 3 строки. Думаю, вам нужны группы по 39 строк. Измените его.
3. TgtClm - Ваши данные находятся в столбце 4 (столбец D). Нет необходимости сейчас менять.

После того, как вы установили эти 3 константы, код готов к запуску. Пожалуйста, попробуйте.

Private Sub CommandButton2_Click()
    ' 034

    Const FirstDataRow  As Long = 2
    Const GroupSize     As Long = 3             ' change to suit
    Const TgtClm        As Long = 4             ' Target Column (4 = column D)
                                                ' the output will be in the adjacent column

    Dim Ws              As Worksheet
    Dim Rng             As Range                ' cells in one group
    Dim lRow            As Long                 ' last used row
    Dim Rstart          As Long                 ' first row in group range
    Dim Rend            As Long                 ' last row in group range


    Set Ws = ActiveWorkbook.Worksheets("Sheet1")            'Set the name of the sheet
    lRow = Ws.Cells(Ws.Rows.Count, TgtClm).End(xlUp).Row    'Find the last used row

    Rstart = FirstDataRow
    Do
        Rend = Application.Min(Rstart + GroupSize - 1, lRow)
        With Ws
            Set Rng = .Range(.Cells(Rstart, TgtClm), .Cells(Rend, TgtClm))
        End With

        Rng.Offset(0, 1).Formula = "=RANK(" & Rng.Cells(1).Address(0, 1) & _
                                          "," & Rng.Address & ",0)"
        Rstart = Rend + 1
        If Rstart > lRow Then Exit Do
    Loop
End Sub

Обратите внимание, что последний 0 в формуле RANK (здесь: & Rng.Address & ",0)") указывает ранжирование в порядке убывания, то есть наибольшее число получит наименьший ранг (100 = 1, 90 = 2 эт c). Измените на 1, если вам нужен обратный порядок.

Answer 2

Я не знаю этот топи c так хорошо, но на веб-странице https://docs.microsoft.com/en-us/office/vba/api/excel.worksheetfunction.rank_eq

написано это выражение.Rank_Eq (Arg1, Arg2, Arg3), а Expression (выражение) Переменная, представляющая объект WorksheetFunction. В вашем коде это выглядит как объект Range.