创建一个没有重复的新列，计算一个数字的频率，并对列进行排序

Question

我想创建一个 Excel 宏来执行以下操作： 在 A 列中取任意长度的数字列表 将唯一值复制到 D 列 使用 COUNTIF 公式填充 E 列，该公式将显示每个唯一数字出现的次数（因此它将具有 D 中的唯一数字，以及它在 E 中出现的次数） 根据列 E' 将列 D 和 E 的值从高到低排序 价值观

我知道如何使用 Excel GUI 执行这些步骤，但我想编写一个 VBA 宏来完成这些步骤。到目前为止，对我来说最困难的部分是让 COUNTIF 公式解决任意长度范围。关于如何实现这一点的任何想法？

编辑： 这是我最新录制的代码：

 Range("A1:A1000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "D1:D2000"), Unique:=True
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(R2C1:R1000C1,RC[-1])"
    Selection.AutoFill Destination:=Range("E2:E1000"), Type:=xlFillDefault
    Columns("D:E").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("E2:E1000") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("D1:E1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

我手动将范围设置为最大 1000，但我实际上想将其设为最后一个单元格中的数据。我想我可以对复制和粘贴部分执行 Range("A1", Range("A1").End(xlDown)) 之类的操作，但是 COUNTIF 不会接受这种表示法，对吗？

Answer 1

COUNTIF 可能不允许该 VBA 表达式，但我们可以先评估该表达式，然后在出现的任何地方使用它来代替“1000”！所以：

Dim maxRow As Long
maxRow = Range("A1").End(xlDown).Row

Range("A1:A" & maxRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
    "D1:D" & maxRow), Unique:=True
Range("E2:E" & maxRow).FormulaR1C1 = "=COUNTIF(R2C1:R" & maxRow & "C1,RC[-1])"

ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("E2:E" & maxRow) _
    , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("D1:E" & maxRow)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

基本上只是在出现的任何地方用 maxRow 替换 1000。另外我清理了Select 的使用（因为它很慢并且容易出现运行时错误）。

不知道为什么在原始代码中使用 D2000 而不是 D1000，所以我对其进行了更改。如果这是故意的，并且您想实际复制到两倍于输入大小的范围内（为什么？），您可以改用 "D1:D" & (2 * maxRow)。