Подсчет определенного числа из группы чисел, разделенных запятой в диапазоне ячеек в Excel

Question

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

1  A        
2  1,2,3
3  1,4,5
4  1,3,5,6

Мне нужно посчитать только «1» из этого столбца A. Аналогично для всех остальных чисел, например, «2», «3» и т. Д.

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

Public Function Count(r As Range) As Long
Dim c As Collection
Set c = New Collection
ary = Split(r.Text, ",")
On Error Resume Next
For Each a In ary
    c.Add a, CStr(a)
    If Err.Number = 0 Then
        Count = Count + 1
    Else
        Err.Number = 0
    End If
Next a
On Error GoTo 0
End Function`

Как изменить это значение на диапазон, а также только на подсчет одного числа из этого диапазона?

Answer 1

Количество вхождений с разделителями (UDF)

Код

'***********************************************************************
' Title:      Count Delimited String Occurrences
' Purpose:    Counts the number of occurrences of a value in delimited parts
'             of cells of a range containing not numeric values.
' Inputs:
'     CountRange:           Required. The range which cells to search.
'     CountValue:           Required. The value to search for. Variant.
'     CountDelimiter:       Optional. The delimiter by which each part of each
'         cell will be checked against CountValue. Default is ",".
'     CompareBinary0Text1:  Optional. The method how the check will be
'         performed. (Binary)  - 0 i.e. AA <> Aa <> aa. Default.
'                    (Textual) - 1 i.e. AA = Aa = aa.
'     All0OnlyOne1:         Optional. Determines if all (0 - Default) or only
'         the first (1) occurrence in each cell has to be found.
'*************************************************************************
Function CDSO(CountRange As Range, CountValue As Variant, _
        Optional CountDelimiter As String = ",", _
        Optional CompareBinary0Text1 As Long = 0, _
        Optional All0OnlyOne1 As Long) As Long

    Dim rng As Range        ' Current Range (of Areas Collection)
    Dim vntR As Variant     ' Range Array (2D 1-based)
    Dim vntC As Variant     ' Cell Array  (1D 0-based)
    Dim vntCell As Variant  ' Cell Variant
    Dim i As Long           ' Current Cell Row Counter
    Dim j As Long           ' Current Cell Column Counter
    Dim k As Long           ' CountRange Areas Counter
    Dim m As Long           ' Cell Array Element Counter
    Dim ValCount As Long    ' Value Counter
    Dim strVal As String    ' Value String
    Dim strCell As String   ' Cell String

    ' Convert CountValue to string (CStr), because arrays created
    ' using Split do only contain strings.
    ' Write CountValue to Value String.
    strVal = CStr(CountValue)

    ' Loop through Areas Collection (ranges) of CountRange.
    For k = 1 To CountRange.Areas.Count
        ' Check if Current Range contains one cell only.
        If CountRange.Areas(k).Cells.Count = 1 Then
            ' Write value of Current Range (one cell only) to Cell Variant.
            vntCell = CountRange.Areas(k)
            ' Go to Occurrences Counter Subroutine.
            GoSub OccurrencesCounter
          Else
            ' Copy Current Range to Range Array.
            vntR = CountRange.Areas(k)
            ' Loop through rows of Range Array.
            For i = 1 To UBound(vntR)
                ' Loop through columns of Range Array.
                For j = 1 To UBound(vntR, 2)
                    ' Write value of current element of Range Array to Cell
                    ' Variant.
                    vntCell = vntR(i, j)
                    ' Go to Occurrences Counter Subroutine.
                    GoSub OccurrencesCounter
                Next
            Next
        End If
    Next
    ' Write value of Value Counter to Count String Occurrences (CDSO).
    CDSO = ValCount

Exit Function

' Occurrences Counter
' Purpose:    Count the number of occurrences of CountValue in Cell String.
OccurrencesCounter:
    ' Check if Cell Variant is a number.
    If IsNumeric(vntCell) Then Return
    ' Write value of Cell Variant converted to string to Cell String.
    strCell = CStr(vntCell)
    ' Check if Cell String is not empty ("").
    If strCell = "" Then Return
    ' Split Cell String by CountDelimiter into Cell Array.
    vntC = Split(strCell, CountDelimiter)
    ' Loop through elements of Cell Array.
    For m = 0 To UBound(vntC)
        ' Sometimes the values contain deliberate or accidental
        ' spaces, so Trim is used to remove them.
        ' If you want to use the vbTextCompare i.e. AA = Aa, AA = aa,
        ' in the formula set CompareBinary0Text1 to 1.
        ' Check if value of current element in Cell Array
        ' is equal to CountValue.
        If StrComp(Trim(vntC(m)), strVal, CompareBinary0Text1) = 0 Then
            ' Count the occurrence i.e. increase Value Counter.
            ValCount = ValCount + 1
            ' Note: If only the first occurrence in each cell is needed,
            '       increase efficiency with Exit For i.e. in the formula
            '       set All0OnlyOne1 to 1.
            ' Check if All0OnlyOne1 is equal to 1.
            If All0OnlyOne1 = 1 Then
                ' Stop looping, occurrence found.
                Exit For
            End If
        End If
    Next
Return

End Function
'******************************************************************************

Answer 2

Вы можете сделать что-то вроде этого:

Public Function CountNum(rng As Range, num) As Long
    Dim rv As Long, c As Range, arr, a
    num = CStr(num)
    For Each c In rng.Cells
        If Len(c.Value) > 0 Then
            arr = Split(c.Value, ",")
            For Each a In arr
                If a = num Then rv = rv + 1
            Next a
        End If
    Next c
    CountNum = rv
End Function

Чтобы позвонить (например):

=countnum(A2:A4,1)