رتبه بندی اسامی بر اساس فراوانی

[mch2v]

سلام
میخواستم اسامی رو که تو یه ستون وجود داره رو بر اساس تعدادشون تو ستون دیگه رتبه بندی کنم ، یعنی اینکه هر اسمی که بیشتر بود تو ستون دیگه اول نوشته بشه و بقیه به همین ترتیب بعد اون نوشته بشن.
لطفا حدالامکان از توابع استفاده بشه ، اگه خیلی سنگین شد اونوقت با vba.
ممنون از همگی.
name.xlsx

[iranweld]

با سلام فایل پیوست را دانلود کنید
ابتدا با advance fillter یک لیست بدون تکرار ایجاد شد
با countif تعداد تکرار هر اسم بدست آمد
با Rank به بیشترین تکرار عدد یک و به همین ترتیب تکرار عدد کمتر اختصاص یافت Dropbox - Copy of name.xlsx

[mch2v]

ممنون
فقط میشه این کارا رو طور دیگه ای (با ترکیب توابع یا vba) توی یه ستون انجام داد و به ستون کمکی نیازی نباشه ؟
با تشکر

[iranweld]

با سلام

لیست کردن با VB و ثبت شمارش تعداد تکرار انجام شد ولی مرحله آخر ردبندی انجام نشد

Sub UniqueCopy()
 Sheet1.Columns(3).Select
 Selection.Clear
 Sheet1.Range("A1").Select
 On Error Resume Next
    With ActiveSheet
         .Range("A1", .Range("A65536").End(xlUp)).AdvancedFilter _
             Action:=xlFilterCopy, CopyToRange:=Sheet1.Range("c1"), Unique:=True
    End With
    

    Dim i As Integer, j As Integer, temp As Integer, rng, RNG1 As Range

Set rng = Range("A1").CurrentRegion
Set RNG1 = Range("C1").CurrentRegion

    For j = 2 To RNG1.Count
    T = 0
    For i = 2 To rng.Count
    If Range("C" & j).Value = Range("A" & i).Value Then
    
    T = T + 1
    
    Range("D" & j).Value = T
    
        End If
        
    Next i
    Next j
   
End Sub 

[Amir Ghasemiyan]

ممنون
فقط میشه این کارا رو طور دیگه ای (با ترکیب توابع یا vba) توی یه ستون انجام داد و به ستون کمکی نیازی نباشه ؟
با تشکر

با vba ميشه كدهاي متنوعي نوشت. من سعي كردم ساده ترين و كوتاه ترين كد رو خدمتتون ارائه كنم

Sub SortedList()
    Range("A1:A52").Copy
    Range("D1").Select
    ActiveSheet.Paste
    ActiveSheet.Range("D1:D52").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("E1").Formula = "=COUNTIF($A$1:$A$52,D1)"
    Range("E1").AutoFill Destination:=Range("E1:E10")
    Range("E1:E10").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("E1"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("D1:E10")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("E1:E10").ClearContents
End Sub