Question

我正在一个项目上，想知道是否可能有一种更快的方法来完成似乎很简单但很耗时的事情。

假设我有一个10单元格的列，填充了1-10之间的随机整数：

1
1
1
5
5
8
8
8
9
9

我想获得此列的x +出现次数。 Func（1）= 4 [因为有4个唯一值且至少出现1次]； Func（2）= 4; func（3）= 2 [因为只有2个唯一值至少出现3次]

现在，我过滤每个可能的整数，然后计算出现次数。如果出现次数> = x，则计数+ = 1。然后循环遍历每个整数。它可以工作，但是在较大范围的单元格和较大范围的整数上，它有点慢。鉴于Excel的灵活性和VBA的强大功能，我想知道是否有人有一个更有效的想法。

Answer 1

一种方法可能是使用类似下面的功能（但是您需要通过执行以下操作来添加引用：Open VB Editor > Click Tools > References > Scroll down to "Microsoft Scripting Runtime" > Tick it > Click OK）

Option Explicit

Public Function CountNumericOccurrences(ByVal someRange As Range, ByVal minimumOccurrenceCount As Long) As Long
    ' "someRange" can be a contiguous or non-contiguous range of cells
    ' "minimumOccurrenceCount" is how many occurrences must be present before that value is counted.
    ' This function will only count numbers (strings, blanks, etc are ignored).

    Dim uniqueCounts As Scripting.Dictionary
    Set uniqueCounts = New Scripting.Dictionary

    Dim contiguousArea As Range
    For Each contiguousArea In someRange.Areas
        If contiguousArea.Cells.Count > 1 Then ' Unlikely that range would contain any single-cell areas
            Dim inputToCheck As Variant
            inputToCheck = contiguousArea.Value

            Dim rowIndex As Long
            Dim columnIndex As Long
            Dim currentKey As String

            For rowIndex = LBound(inputToCheck, 1) To UBound(inputToCheck, 1)
                For columnIndex = LBound(inputToCheck, 2) To UBound(inputToCheck, 2)
                    If Application.IsNumber(inputToCheck(rowIndex, columnIndex)) Then ' IsNumeric returns True for vbEmpty, so isNumber is used instead.
                        currentKey = CStr(inputToCheck(rowIndex, columnIndex))
                        If Not uniqueCounts.Exists(currentKey) Then uniqueCounts.Add currentKey, 0 ' Default value
                        uniqueCounts(currentKey) = uniqueCounts(currentKey) + 1
                    End If
                Next columnIndex
            Next rowIndex

        ElseIf Application.IsNumber(contiguousArea) Then ' Handle single-cell edge case
            currentKey = CStr(contiguousArea) ' We repeat ourselves here. Could create a "default dictionary" class, but only 3 lines repeated.
            If Not uniqueCounts.Exists(currentKey) Then uniqueCounts.Add currentKey, 0 ' Default value
            uniqueCounts(currentKey) = uniqueCounts(currentKey) + 1
        End If
    Next contiguousArea

    For rowIndex = 0 To (uniqueCounts.Count - 1)
        If uniqueCounts.Items(rowIndex) >= minimumOccurrenceCount Then
            CountNumericOccurrences = CountNumericOccurrences + 1
        End If
    Next rowIndex
End Function

如果将其放入新模块中，则可以从工作表中这样调用它：

我用200k个电池组成的射程进行了测试，耗时约4秒（非常慢）。也许使用集合是更好的方法。

您也可以将其作为常规过程的一部分进行调用，例如：

Option Explicit

Private Sub SomeProcedure()
    Dim someValue As Long
    someValue = CountNumericOccurrences(ThisWorkbook.Worksheets("Sheet1").Range("A1:A200000"), 3)
    MsgBox someValue
End Sub

计算范围内的值的X +次出现次数

1 个答案: