count похожие строки и список сортировки

Question

Добрый день всем! У меня пока нет примера кода, потому что я фактически застрял с самим решением. Вот почему я спрашиваю хотя бы о том, как решить следующую проблему. Мне нужно, чтобы подсчитать аналогичные значения ячейки в столбце A и отсортировать их по количеству сходств.

визуальный пример:

JustAValue001 
JustAValue001 
JustAValue001 
AnotherValue002 
AnotherValue002 
ThirdValue003 
ThirdValue003 
ThirdValue003 
ThirdValue003 

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

ThirdValue003 
ThirdValue003 
ThirdValue003 
ThirdValue003 
JustAValue001 
JustAValue001 
JustAValue001 
AnotherValue002 
AnotherValue002 

Сортировка так, что самый высокий подсчет данных первой, а затем второй по величине, пока он не получает наименьшее количество в нижней

будет оценить любой хорошая идея. С уважением.

Answer 1

Я вижу, что это базовая функция сортировки. Я помещал вам последовательность ввода в Excel и нажимал на Sort from Z to A, и он дал мне результат, который вы просили. Пожалуйста, сообщите нам немного более ясно.

Попробуйте приведенный ниже код. Он работал идеально для меня, хотя его немного больше

Sub HighOnTop() 
    Dim uniqueValues() 
    Dim uniqValuesCounts() 
    Dim TotalUniqueCount 
    'Writing Unique values to Column C 
    Sheets("UrSheet").Activate 
    Columns("A:A").Select 
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Columns(_ 
      "A:A"), CopyToRange:=Range("C1"), Unique:=True 
     I = 0 
     Do While (Cells(I + 1, 3).Value <> "") 
     I = I + 1 

     Loop 
     TotalUniqueCount = I 
    ReDim uniqueValues(TotalUniqueCount - 1) 
    ReDim uniqValuesCount(TotalUniqueCount - 1) 

    For j = 1 To TotalUniqueCount - 1 
    uniqueValues(j) = Cells(j + 1, 3) 
    uniqValuesCount(j) = Application.WorksheetFunction.CountIf(Range("A:A"), uniqueValues(j)) 
    Next 
    Set x = Worksheets.Add 
    x.Name = "Temp" 
    x.Activate 
    For k = 1 To TotalUniqueCount - 1 
    Cells(k, 1) = uniqueValues(k) 
    Cells(k, 2) = uniqValuesCount(k) 
    Next 
    Columns("B:B").Select 
    x.Sort.SortFields.Clear 
     x.Sort.SortFields.Add Key:=Range("B1"), _ 
      SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal 
     With x.Sort 
      .SetRange Range("A:B") 
      .Header = xlNo 
      .MatchCase = False 
      .Orientation = xlTopToBottom 
      .SortMethod = xlPinYin 
      .Apply 
     End With 
     For j = 1 To TotalUniqueCount - 1 
     uniqueValues(j) = Cells(j, 1) 
     uniqValuesCount(j) = Cells(j, 2) 
     Next 
    Application.DisplayAlerts = False 
    x.Delete 
    Sheets("UrSheet").Activate 
    p = 2 
    For l = 1 To TotalUniqueCount - 1 
     For m = 1 To uniqValuesCount(l) 
     Cells(p, 1) = uniqueValues(l) 
     p = p + 1 
     Next 
    Next 
    End Sub