如何用VBA实现Excel单列唯一值提取及出现次数统计

• 打开你要处理的Excel文件，按下Alt + F11调出VBA编辑器
• 在左侧项目资源管理器右键点击当前工作簿，选择「插入」→「模块」
• 将下方代码粘贴到模块编辑窗口中，按下F5运行即可

Sub 统计A列唯一值及出现次数()
    Dim dict As Object
    Dim lastRow As Long
    Dim cell As Range
    Dim i As Long
    
    ' 创建字典对象用于存储唯一值和计数
    Set dict = CreateObject("Scripting.Dictionary")
    ' 获取A列最后一个有数据的行号
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 遍历A列所有非空单元格
    For Each cell In Range("A1:A" & lastRow)
        If cell.Value <> "" Then
            ' 键存在则计数+1，不存在则新增键并赋值为1
            dict(cell.Value) = dict(cell.Value) + 1
        End If
    Next cell
    
    ' 清空B列原有数据，不需要可注释掉此行
    Columns("B:B").ClearContents
    
    ' 将结果输出到B列
    For i = 0 To dict.Count - 1
        Cells(i + 1, "B").Value = dict.Keys(i) & " " & dict.Items(i)
    Next i
    
    ' 释放对象
    Set dict = Nothing
End Sub

如果A列第一行是表头不需要统计，将遍历代码中的Range("A1:A" & lastRow)修改为Range("A2:A" & lastRow)即可；默认输出顺序和值在A列首次出现的顺序一致，需要按次数排序可额外添加排序逻辑。

内容的提问来源于stack exchange，提问作者Kostyarik