需要在Excel vba列中对重复的文本值进行排名

Question

我在列中有大约300个名字，我想对它们进行排名，并希望包含重复值，例如：如果Smith在列表中排名第3和第4，那么它们将被放在那里。

我的当前代码，无效：

Sub karp()
Dim Prescribers As Worksheets
Dim n, r, LR As Long
Dim name1, name2 As String

LR = Cells(Rows.Count, "b").End(xlUp).Row

    For n = 4 To LR         'to loop through the range for a match
        For a = 1 To 273    'number of possible name ranks
            Sheets("Names").Cells(n, 3) = a                       'places rank score
                name1 = Sheets("Names").Cells(n, 3).Value         'checks name
                name2 = Sheets("Names").Cells(n + 1, 3).Value     'checks next name
            If name1 <> name2 Then
        Next a
        Next n
             End If
    Next n

End Sub

有关维修的任何建议吗？

Answer 1

如果我正确理解，那么你可以使用它：

Sub karp()
    Dim i&, Cl As Range, rn&
    Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = vbTextCompare
    i = Cells(Rows.Count, "b").End(xlUp).Row
    rn = 1
    For Each Cl In Range("C4:C" & i)
        If Not Dic.exists(Trim(Cl.Value) & Trim(Cl.Offset(, 1).Value)) Then
            Dic.Add Trim(Cl.Value) & Trim(Cl.Offset(, 1).Value), rn
            rn = rn + 1
        End If
    Next Cl
    For Each Cl In Range("C4:C" & i)
        Cl.Offset(, 2).Value = Dic(Trim(Cl.Value) & Trim(Cl.Offset(, 1).Value))
    Next Cl
End Sub

输出