Question

大家下午好！我还没有代码示例，因为我实际上已经解决了解决方案本身。这就是为什么我至少要问一个如何解决以下问题的想法。我需要的是计算A列中相似的单元格值，并根据相似数量对其进行排序。

一个直观的例子：

JustAValue001
JustAValue001
JustAValue001
AnotherValue002
AnotherValue002
ThirdValue003
ThirdValue003
ThirdValue003
ThirdValue003

我想要实现的实际上是按类似值的数量对此列表进行排序。所以，正确的应该是这样的：

ThirdValue003
ThirdValue003
ThirdValue003
ThirdValue003
JustAValue001
JustAValue001
JustAValue001
AnotherValue002
AnotherValue002

排序，以便首先计算最高数据量，然后是第二高数据，直至最低数量为止

会欣赏任何好主意。亲切的问候。

Answer 1

我看到这是基本的排序功能。我在Excel中输入了输入序列，然后点击从Z到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

计算类似的行和排序列表

1 个答案: