игнорировать негзначения в функции ранга VBA

Question

У меня есть огромный файл, в котором я хочу оценить все значения в столбце, где значение "0" даст мне ранг один.Пока проблем нет.Основная проблема в том, что у меня также есть отрицательные числа, и, пока у меня есть эти отрицательные числа, они всегда будут иметь рейтинг «ниже», чем «0» или любое другое число.

Есть ли в любом случае, чтобы исключить отрицательные числа изфункция .Rank?

Я мог бы дать им номер заполнителя, но это противоречит цели, так как я хочу запустить этот код в нескольких «рейтингах», а также мне нужны «реальные» числа для других вычислений.

Некоторый код был удален, и это в основном то, что я запускаю сейчас:

Sub test()
lastrow = Worksheets("Sheet").Range("A65536").End(xlUp).Row
Dim Lista As Range
Set Lista = Sheets("Sheet").Range("A1:A100")


For i = 1 To lastrow
    irRanking = WorksheetFunction.Rank_Eq(Worksheets("Sheet").Cells(i,1) 
.Value, Lista, 1)
    Worksheets("Sheet").Cells(i, 4).Value = irRanking
Next i
End Sub

Или есть другой способ сделать это, пропуская .Rank вообще?

Также нужно добавить, чтоя знаю, что это возможно с помощью формул, но мне действительно нужно решение в VBA

Answer 1

Вы можете посчитать отрицательные значения и вычесть эту сумму до ранга:

Option Explicit

Sub test()
    Dim lastrow As Long, i As Long, nNegs As Long
    Dim Lista As Range

    With Worksheets("Sheet")
        lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set Lista = .Range("A1:A" & lastrow)
        For i = 1 To lastrow
            If Lista(i, 1) >= 0 Then .Cells(i, 4) = WorksheetFunction.Rank_Eq(Lista(i, 1), Lista, 1)
        Next i

        nNegs = WorksheetFunction.CountIf(Lista, "<0") ' count negative occurrences
        If nNegs > 0 Then 'if any
            Dim cell As Range
            For Each cell In Lista.Offset(, 3).SpecialCells(xlCellTypeConstants, xlNumbers) ' loop through ranks and correct them by subtratcing the number of negative values
                cell.Value = cell.Value - nNegs
            Next
        End If
    End With
End Sub

Answer 2

Предполагая, что ваши номера в ячейках A2: AXX

=IF($A2>0,MATCH($A2,SMALL(IF($A$2:$A$XX>0,$A$2:$A$XX),ROW(INDIRECT("1:"&COUNTIF($A$2:$A$XX,">0")))),0),"")