枚举Excel范围内的所有数据，对它们进行计数并按出现次数排序

Question

我有一个范围“G2:N”和 Lastrow。我想枚举这些单元格中>1的所有数据，将它们分开并在下一列中对它们进行计数，然后按每个出现的时间对它们进行排序。

我找到了这段代码，将这八列放入一列中。我无法对它们进行计数并将它们分别放入表格中。

Sub MoveData()

START_ROW = 2
START_COL = 7
STEP_COL = 1
OUTPUT_ROW = 2
OUTPUT_COL = 32

Row = START_ROW
Col = START_COL
Out_Row = OUTPUT_ROW
While Col < 15
    While Row < Lastrow
        If Cells(Row, Col).Value <> "" Then
            Cells(Out_Row, OUTPUT_COL).Value = Cells(Row, Col).Value
            Out_Row = Out_Row + 1
        End If
        Row = Row + 1
    Wend
    Row = START_ROW
    Col = Col + STEP_COL
Wend
End Sub

数据示例：

Answer 1

• 将数据表加载到数组中
• 循环数据并使用 Dictionary 对象对其进行计数

微软文档：

Range.CurrentRegion 属性 (Excel)

Range.End 属性 (Excel)

范围.排序方法（Excel）

Sub Demo()
    Dim objDic As Object, rngData As Range
    Dim i As Long, sKey As String, j As Long
    Dim arrData
    Dim oSht As Worksheet
    Set oSht = Sheets("Sheet1")  ' modify as needed
    Set objDic = CreateObject("scripting.dictionary")
    Set rngData = oSht.Range("G2:N" & Cells(Rows.Count, "G").End(xlUp).Row)
    arrData = rngData.Value
    For i = LBound(arrData) To UBound(arrData)
        For j = LBound(arrData, 2) To UBound(arrData, 2)
            sKey = arrData(i, j)
            If Val(sKey) > 1 Then
                If objDic.exists(sKey) Then
                    objDic(sKey) = objDic(sKey) + 1
                Else
                    objDic(sKey) = 1
                End If
            End If
        Next j
    Next i
    Sheets.Add
    Range("A1:B1") = Array("Value", "Count")
    Range("A2").Resize(objDic.Count, 1) = Application.Transpose(objDic.keys)
    Range("B2").Resize(objDic.Count, 1) = Application.Transpose(objDic.items)
    Range("A1").CurrentRegion.Sort Key1:=Columns(2), order1:=xlDescending
    Set objDic = Nothing
End Sub