Как подсчитать число дубликатов если значения неизвестны?

Здравствуйте,

дан столбец с буквами, например, A, B, C, A, A, C, D, C, B, B...

Нужно подсчитать, сколько раз каждая буква входит в столбец, но проблема в том, что неизвестно, какие именно буквы туда входят. Нужно построить то, что в Питоне называется словарём, то есть, получить таблицу вида: А 3, B 3, C 3, D 1 и т. п. То есть, Excel должен сам сформировать множество букв, пробегая по столбцу, и подсчитать количество.

Как это сделать? Я даже прошу не столько формулу, сколько направление, в котором искать информацию. Как сформулировать задачу в терминах Excel?

Спасибо.

Если умеете писать макросов на VBA for EXCEL - то напишите макрос пользуяс двойном
циклом :
например :

For ... to
...
next
или
repeat
...
until
или
do
...
loop
Где в первом цикле проходите по столбец с буквами, а во втором накопляйте число каждого из встретившим
в столбец букв. Отделно создайте масив с множество букв и проверяйте каждой элемент
столбца с какой из букв множества совпадает - тогда по этом индиксом и нокопляйте число встретившим в столбец букв.

Возможно сделать все в одном цикле перебора букв.
Для этого нужно найти способ учитывать встречалась это буква или нет ранее.

Используйте функцию COUNTIF (английская версия), или ZÄHLENWENN (немецкая версия), или СЧЁТЕСЛИ (русская версия)

А можно с помощь функции пользователя.
Я написал ее программку на Excel-VBA. К сожалению, без вложенного цикла не обошлось:

Function WasWieOft(Feld As Range) As String
Dim X, List(), Table(), Anzahl() As Integer
Dim N As Integer, i As Integer, j As Integer, k As Integer
Dim WasNot As Boolean
N = 0
For Each X In Feld ' считывает таблицу в массив "Table"
N = N + 1
ReDim Preserve Table(1 To N) ' копия таблицы Excel
Table(N) = X
Next
k = 0 ' счетчик списка, в котором не будет повторений
For i = 1 To N ' текущая строка в таблице
WasNot = True
For j = 1 To i - 1 ' проверяет, встречалась ли такая буква в предыдущих строках
If Table(i) = Table(j) Then ' если такая буква уже была раньше
WasNot = False
Exit For
Else
WasNot = True
End If
Next j
If WasNot Then
k = k + 1
ReDim Preserve List(1 To k)
ReDim Preserve Anzahl(1 To k)
Anzahl(k) = 0
List(k) = Table(i)
For j = i To N ' считает, сколько раз повторяется новая буква в нижележащем списке
If Table(j) = List(k) Then Anzahl(k) = Anzahl(k) + 1
Next j
End If
Next i
WasWieOft = ""
For i = 1 To k
WasWieOft = WasWieOft & List(i) & " = " & Anzahl(i) & " "
Next i
End Function

С одним циклом
Public Sub CountingUniqueValues()
Dim cell As Range 'Текущая ячейка
Set cell = Application.ActiveCell

Dim processedRange As Range 'Диапозон, в котором считаем уникальные значения
Set processedRange = Application.InputBox("Выберите диапозон: ", "Меню выбора диапозона", Type:=8)

'А нужны ли проверки 1. выбран ли диапазон ?
' 2. пересечения диапозона и текущей ячейки пусто?
' 3. ....

Dim k As Integer 'Количество найденных уникальных значений
k = 0

Dim iterateCell As Range 'Для перебора ячеек диапозона
Dim auxiliaryCell As Range 'Для проверки встречали мы уже уникальное значение при переборе или нет
'Можно обойтись строкой, если мы уверены, что проверяемые значения - только буквы
'Но тогда нужно использовать функцию InStr поиска в строке, а не Find
'А вообще можно через словарь CreateObject("Scripting.Dictionary") или CreateObject("System.Collections.ArrayList"),
' но лень разбираться

Application.ScreenUpdating = False 'скрываем работу макроса

For Each iterateCell In processedRange
If k > 0 Then
Set auxiliaryCell = Range(cell, cell.Offset(k - 1, 0)).Find(iterateCell.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
If auxiliaryCell Is Nothing Then
cell.Offset(k, 0).Value = iterateCell.Value
cell.Offset(k, 1).Value = 1
k = k + 1
Else
auxiliaryCell.Offset(0, 1) = auxiliaryCell.Offset(0, 1) + 1
End If
Else
cell.Value = iterateCell.Value
cell.Offset(0, 1).Value = 1
k = 1
End If
Next

Application.ScreenUpdating = True
End Sub



Без циклов
Public Sub CountingUniqueValues1()
Dim cell As Range 'Текущая ячейка
Set cell = Application.ActiveCell

Dim processedRange As Range 'Диапозон, в котором считаем уникальные значения
Set processedRange = Application.InputBox("Выберите диапозон: ", "Меню выбора диапозона", Type:=8)

'А нужны ли проверки 1. выбран ли диапазон ?
' 2. пересечения диапозона и текущей ячейки пусто?
' 3. ....

Application.ScreenUpdating = False 'скрываем работу макроса

processedRange.Copy cell ' Копирум диапозон в активную ячейку
Range(cell, cell.Offset(processedRange.Rows.Count - 1, 0)).RemoveDuplicates (1) ' Удаляем дупликаты в скопированном дипозоне !!! не различает регистр !!!

Dim k As Integer 'количество уникальных значений
k = WorksheetFunction.CountA(Range(cell, cell.Offset(processedRange.Rows.Count - 1, 0)))

'!!! Не учитывает регистр !!!
Range(cell.Offset(0, 1), cell.Offset(k - 1, 1)).FormulaArray = "=COUNTIF(" + processedRange.Address + ", " + Range(cell, cell.Offset(processedRange.Rows.Count - 1, 0)).Address + ")"

Application.ScreenUpdating = True
End Sub