Private Sub Stat()
Dim D As Object, R As Range, n As Long
Application.ScreenUpdating = 0
Set D = CreateObject("Scripting.Dictionary")
For Each R In Range("C2", [C65000].End(xlUp)): D(R.Value) = "": Next
n = D.Count
[F2].Resize(n) = Application.Transpose(D.keys)
[G2].Resize(n).FormulaLocal = "=NB.SI(C:C;F2)"
Range("F2:G" & n) = Range("F2:G" & n + 1).Value
Range("F2:G" & n + 1).Sort [G2], 2
End Sub