Сначала введите этот код VBA в стандартном модуле:
Public Function MostCommon(rng As Range) As Variant
Dim rng2 As Range, r As Range, C As Collection, arr(), arr2
Dim cKount As Long, i As Long, Kaller As Range, HowBig As Long
Set rng2 = Intersect(rng, rng.Parent.UsedRange)
Set C = New Collection
Set Kaller = Application.Caller
For Each r In rng2
If r.Value <> "" Then
On Error Resume Next
C.Add r.Value, CStr(r.Value)
On Error GoTo 0
End If
Next r
cKount = C.Count
ReDim arr(1 To cKount, 1 To 2)
For i = 1 To cKount
arr(i, 1) = C.Item(i)
arr(i, 2) = Application.WorksheetFunction.CountIf(rng2, arr(i, 1))
Next i
Call VBA_Sort(arr)
HowBig = Application.WorksheetFunction.Max(cKount, Kaller.Rows.Count)
ReDim arr2(1 To HowBig, 1 To 2)
For i = 1 To HowBig
arr2(i, 1) = ""
arr2(i, 2) = ""
Next i
For i = 1 To cKount
arr2(i, 1) = arr(i, 1)
arr2(i, 2) = arr(i, 2)
Next i
MostCommon = arr2
End Function
Public Sub VBA_Sort(InOut())
Dim i As Long, J As Long, Low As Long, _
Hi As Long, Temp As Variant
Low = LBound(InOut, 1)
Hi = UBound(InOut, 1)
J = (Hi - Low + 1) \ 2
Do While J > 0
For i = Low To Hi - J
If InOut(i, 2) < InOut(i + J, 2) Then
Temp = InOut(i, 2)
InOut(i, 2) = InOut(i + J, 2)
InOut(i + J, 2) = Temp
Temp = InOut(i, 1)
InOut(i, 1) = InOut(i + J, 1)
InOut(i + J, 1) = Temp
End If
Next i
For i = Hi - J To Low Step -1
If InOut(i, 2) < InOut(i + J, 2) Then
Temp = InOut(i, 2)
InOut(i, 2) = InOut(i + J, 2)
InOut(i + J, 2) = Temp
Temp = InOut(i, 1)
InOut(i, 1) = InOut(i + J, 1)
InOut(i + J, 1) = Temp
End If
Next i
J = J \ 2
Loop
End Sub
Затем выберите блок из двух столбцов (например, E1 - F50 ) и введите в массиве следующее:
=MostCommon(C:C)
Как видите, функция возвращает таблицу с короткими частотами с наиболее частыми элементамивверху.
Формулы массива необходимо вводить с помощью Ctrl + Shift + Введите вместо Введите ключ.Если это сделано правильно, формула появится в фигурных скобках вокруг нее в строке формул.