lotto 5 min

---

Dim nCnt As Long
Dim nMax As Long
Dim cDati As New Collection
Dim cMax As New Collection
Dim cOrdine As New Collection
Dim cella As Range
Dim vDato As Variant
Dim aDati() As Long
Dim vRetVal As Variant
Dim j As Integer

Dim rng As Range
Dim ultC As Long

Application.Volatile
ultC = Sheets("Archivio").Range("C" & Rows.Count).End(xlUp).Row

Set rng = Sheets("Archivio").Range("C" & ultC - 11, "V" & ultC)
On Error Resume Next
For Each cella In rng
With cella
nCnt = Application.WorksheetFunction.CountIf(rng, .Value)
cDati.Add Array(.Value, nCnt), CStr(.Value)
cMax.Add nCnt, CStr(nCnt)
End With
Next
On Error GoTo 0
j = 0
ReDim aDati(1 To cMax.Count)
For Each vDato In cMax
j = j + 1
aDati(j) = vDato
Next

nPos = Application.WorksheetFunction.Max(nPos, 1)
nPos = Application.WorksheetFunction.Min(nPos, cDati.Count)
'eventualemente togliere il commento alla riga sotto
'nPos = Application.WorksheetFunction.Min(nPos, cMax.Count)
nMax = Application.WorksheetFunction.Large(aDati, nPos)

On Error Resume Next
For Each vDato In cDati
If vDato(1) = nMax Then
vRetVal = vRetVal & "; " & vDato(0)
Else
cOrdine.Add vDato, CStr(vDato(0))
End If
Next
vRetVal = Mid(vRetVal, 3)
cOrdine.Add Array(vRetVal, nMax), CStr(vRetVal)
On Error GoTo 0

For Each vDato In cOrdine
If vDato(1) = nMax Then
vRetVal = vDato(0)
End If
Next

If IsNumeric(vRetVal) Then vRetVal = vRetVal * 1

uModa2 = Array(vRetVal, nMax)

End Function

---