Отображение количества для каждого уникального значения в столбце таблицы

Если ваши ячейки находятся в A1:A4, поместите эту формулу массива в ячейки B1:B4:

{=$A$1:$A$4&": "&COUNTIF($A$1:$A$4,$A$1:$A$4)}

Это создаст ваши строки, которые будут выглядеть как itemA: 2 и itemB: 1, но будут повторения.

Затем вы должны использовать код VBA, который вы предложили в комментариях. Я помещаю это здесь для полноты картины:

Function ConcatUniq(ByRef rng As Range) As String
    Dim r As Range
    Static dic As Object
    If dic Is Nothing Then Set dic = CreateObject("Scripting.Dictionary")
    For Each r In rng
        If r.Value <> Empty Then
            dic(r.Value) = Empty
        End If
    Next
    ConcatUniq = Join$(dic.keys, ", ")
    dic.RemoveAll
End Function

Таким образом, формула ячейки вашей окончательной строки будет выглядеть так:

=ConcatUniq(B1:B4)

Это решение VBA использует определяемую пользователем функцию, которая:

.- Проверяет, что Target Range принадлежит ListObject (таблице Excel).

.- Использует Array для хранения всех значений статуса из таблицы.

.- Использует строку Control для проверки статуса уникальности.

.- Использует строку Output для хранения списка уникальных статусов с соответствующим количеством.

Примечание. Список будет иметь тот же порядок, что и в таблице. Сортировка не входит в объем вопроса, но если вы хотите, чтобы она была отсортирована, я предлагаю отсортировать ListObject по мере необходимости (не включено).

Попробуйте следующую процедуру (см. комментарии к коду):

Private Function Lob_Status_Count(rTrg As Range) As String
Const kStt As String = "Status"
Dim lob As ListObject
Dim sControl As String, sOutput As String
Dim aStt As Variant, vStt As Variant, bStt As Byte
    Rem Validate Input
    On Error Resume Next
    Set lob = rTrg.ListObject               'Set ListObject
    On Error GoTo 0
    If lob Is Nothing Then GoTo ExitTkn     'Exit if Target range is not a ListObject

    With lob.ListColumns(kStt).DataBodyRange

        Rem Set Status Array
        aStt = WorksheetFunction.Transpose(.Value2)

        Rem Set Status Output
        For Each vStt In aStt
            If InStr(sControl, Chr(167) & vStt & Chr(167)) = 0 Then     'Validates uniqueness
                bStt = WorksheetFunction.CountIf(.Cells, vStt)          'Gets Status Count
                sOutput = sOutput & ", " & bStt & " " & vStt            'Adds to Results
                sControl = sControl & Chr(167) & vStt & Chr(167)        'Adds to Control
        End If: Next

        Rem Cleanup Output
        sOutput = Replace(sOutput, ", ", vbNullString, 1, 1)

    End With

    Rem Set Results
    Lob_Status_Count = sOutput

Exit Function
ExitTkn:
    Lob_Status_Count = "!Err ListObject"

End Function

Предлагаем прочитать следующие страницы, чтобы получить более глубокое представление об используемых ресурсах:

Использование массивов, Члены ListObject (Excel), Объект WorksheetFunction (Excel),

Для каждого...следующего утверждения Функция InStr, Заявление об ошибке.