Подсчитать количество X + вхождений значения в диапазоне

Question

Я работаю над проектом, и мне было интересно, может ли быть более быстрый способ сделать что-то, что кажется простым, но довольно трудоемким.

Представьте, что у меня есть столбец из 10 ячеек, заполненный случайными целыми числами из1-10:

1. 1
2. 1
3. 1
4. 5
5. 5
6. 8
7. 8
8. 8
9. 9
10. 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

Если вы поместите его в новый модуль, вы можете вызвать его из таблицы следующим образом:

Я протестировал его с диапазоном, состоящим из 200 тыс. Ячеек, и это заняло ~ 4 секунды (довольно медленно). Возможно, лучше использовать коллекцию.

Вы также можете просто вызывать его как часть обычной процедуры, например ::

Option Explicit

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