Excel VBA需求：枚举指定区域>1的数据、计数并按出现次数降序排序

问题背景 #

需要处理Excel中G2:N&Lastrow范围的数据，完成以下操作：

• 提取所有大于1的数据
• 在相邻列统计每个值的出现次数
• 按出现次数降序排序

原代码仅实现了多列合并为单列，缺少筛选、计数和排序功能，以下是完整解决方案：

完整VBA代码 #

Sub ExtractAndCount()
    Dim START_ROW As Long, START_COL As Long
    Dim OUTPUT_ROW As Long, OUTPUT_COL As Long
    Dim Lastrow As Long, Row As Long, Col As Long
    Dim dataDict As Object
    Dim key As Variant
    
    ' 初始化参数
    START_ROW = 2
    START_COL = 7 ' G列对应的列号
    OUTPUT_ROW = 2
    OUTPUT_COL = 32 ' 输出起始列（AF列）
    
    ' 获取目标区域的最后一行（取G到N列中数据最多的行号）
    Lastrow = Cells(Rows.Count, START_COL).End(xlUp).Row
    For Col = START_COL To 14 ' N列对应的列号是14
        If Cells(Rows.Count, Col).End(xlUp).Row > Lastrow Then
            Lastrow = Cells(Rows.Count, Col).End(xlUp).Row
        End If
    Next Col
    
    ' 创建字典用于去重和计数
    Set dataDict = CreateObject("Scripting.Dictionary")
    
    ' 遍历目标区域，筛选并计数
    Col = START_COL
    While Col <= 14
        Row = START_ROW
        While Row <= Lastrow
            ' 仅处理数值类型且大于1的数据
            If IsNumeric(Cells(Row, Col).Value) And Cells(Row, Col).Value > 1 Then
                Dim val As Double
                val = Cells(Row, Col).Value
                ' 更新字典计数
                If dataDict.Exists(val) Then
                    dataDict(val) = dataDict(val) + 1
                Else
                    dataDict(val) = 1
                End If
            End If
            Row = Row + 1
        Wend
        Row = START_ROW
        Col = Col + 1
    Wend
    
    ' 将计数结果输出到指定列
    Out_Row = OUTPUT_ROW
    For Each key In dataDict.Keys
        Cells(Out_Row, OUTPUT_COL).Value = key
        Cells(Out_Row, OUTPUT_COL + 1).Value = dataDict(key)
        Out_Row = Out_Row + 1
    Next key
    
    ' 按出现次数降序排序
    Range(Cells(OUTPUT_ROW, OUTPUT_COL), Cells(Out_Row - 1, OUTPUT_COL + 1)).Sort _
        Key1:=Cells(OUTPUT_ROW, OUTPUT_COL + 1), Order1:=xlDescending, Header:=xlNo
    
    ' 释放资源
    Set dataDict = Nothing
End Sub

代码关键说明 #

• Lastrow准确获取：遍历G到N列取最大行号，避免因某列数据较短导致遗漏
• 字典计数：利用Scripting.Dictionary自动去重，高效统计每个值的出现次数
• 数据筛选：加入IsNumeric判断和>1条件，排除无效数据
• 排序处理：调用Excel内置排序功能，直接对结果按次数降序排列

使用方法 #

1. 打开目标Excel文件，按Alt+F11进入VBA编辑器
2. 右键点击项目，选择「插入」→「模块」
3. 将上述代码粘贴到模块中，按F5运行即可

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