根据列值的排名粘贴结果

Question

我有这段代码，它工作得很好我一直面临的问题是代码没有根据排名粘贴结果。

我想将第一个 1 添加到排名最高的值，然后添加到第二高然后第三高等等...最后一个 1 将添加到排名最低的值.

代码将在该范围内找到它们的排名，根据该排名在其旁边的列中添加 1。这样做直到每个单元格都加 1（0 除外）。

我知道对于最终结果，排名无关紧要。但是需要添加排名逻辑。

您的帮助将不胜感激。

Sub SlowRange()

    Dim LastRow As Long
    LastRow = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
    Dim rg As Range: Set rg = Sheet1.Range("A2:A" & LastRow)
    
    Dim c As Range
    For Each c In rg.Cells
        If c.Value <> 0 Then
            c.Offset(, 1).Value = 1
        'Else
        '    c.Offset(, 1).Value = Empty
        End If
    Next c

End Sub

Answer 1

请试试这个代码。

Sub WriteRanks()
    ' 226 - 27 Apr 2021
    
    Dim Rng         As Range            ' range to rank
    Dim Arr         As Variant          ' numbers to rank
    Dim ArrNew      As Variant          ' tie-broken Ar
    Dim Ct          As Long             ' temporary column
    Dim R           As Long             ' loop counter: array rows
    
    Application.ScreenUpdating = False
    With Worksheets("Sheet1")           ' change to suit
        ' from row 2 in column A to the end of column A
        Set Rng = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
        Arr = Rng.Value
        ReDim ArrNew(1 To UBound(Arr))
        For R = 1 To UBound(Arr)
            ' add a tie breaker: 10th digit
            ArrNew(R) = Arr(R, 1) + (R / (10 ^ 10))
        Next R
        
        With .UsedRange                 ' find a blank column on the right
            Ct = .Column + .Columns.Count
        End With
        Set Rng = Rng.Offset(0, Ct)
        Rng.Value = Application.Transpose(ArrNew)    ' fill the helper column
        
        For R = 1 To UBound(Arr)
            If Arr(R, 1) Then .Cells(R + 1, "B").Value = WorksheetFunction.Rank(ArrNew(R), Rng, 0)
        Next R

        ' delete the helper column
        .Columns(Rng.Column).EntireColumn.Delete
    End With
    Application.ScreenUpdating = False
End Sub

请注意，决胜局将 R * 1/10000000000 (=10 ^ 10) 添加到每个数字。这应该是一个无关紧要的数字，但由于它乘以行​​号，它可能在第 100,000 行变得重要。这里的余额取决于您有多少行以及您的数字中有多少位。使用 0.0869652（7 位）直到第 1,000 行应该仍然可以，但在第 100,000 行，您可能希望切换到 10 ^ 12。

决胜局不会影响您的原始数字，只会影响它们的排名。当相同的数字出现多次时。