paoloard wrote :
> Non mi viene altra soluziuone che questa con una riga d'appoggio (spero che
> altri abbiano un'idea migliore, ne prenderei volentieri nota).
[...]
Ho speso un paio d'ore abbondanti, durante la digestione dal frugale
mio pasto pasquale, per tirar fuori la funzione che allego.
Non è utilizzabile dall'OP perché ho previsto la definizione di un
range su cui operare e non un gruppo non sequenziale di celle.
Occorre il riferimento a MS Scripting Runtine.
=================================
Public Function ModaF(StartCell As Range) As String
Dim dictCC As New Dictionary, SourceRange As Range
Dim i, j, k, OldItem As Long, arrDict(), Swap1, Swap2
If Not IsNull(StartCell(2)) Then
Set SourceRange = Range(StartCell, StartCell.End(xlDown))
End If
dictCC.CompareMode = TextCompare
For Each i In SourceRange
k = k + 1
If Not dictCC.Exists(i.Value) Then
dictCC.Add Key:=i.Value, Item:=1
Else
OldItem = dictCC.Item(i.Value)
dictCC.Remove (i.Value)
dictCC.Add (i.Value), OldItem + 1
End If
Next
ReDim arrDict(0 To dictCC.Count - 1, 0 To 1)
For i = 0 To dictCC.Count - 1
arrDict(i, 0) = dictCC.Keys(i)
arrDict(i, 1) = dictCC.Items(i)
Next
For i = LBound(arrDict, 1) To UBound(arrDict, 1) - 1
For j = i + 1 To UBound(arrDict, 1)
If arrDict(i, 1) > arrDict(j, 1) Then
Swap1 = arrDict(j, 0)
Swap2 = arrDict(j, 1)
arrDict(j, 0) = arrDict(i, 0)
arrDict(j, 1) = arrDict(i, 1)
arrDict(i, 0) = Swap1
arrDict(i, 1) = Swap2
End If
Next
Next
ModaF = arrDict(UBound(arrDict, 1), 1) & _
" - " & arrDict(UBound(arrDict, 1), 0)
End Function
====================================
Ciao e Buona Pasquetta
Bruno