Sub ErmitteleHaeufigsteZahl()
Dim ws As Worksheet
Dim rng As Range, cell As Range
Dim dict As Object
Dim maxCount As Integer
Dim mostFrequent As Double
Dim key As Variant
Dim roundedValue As Double
Set ws = ThisWorkbook.Sheets(1)
Set rng = ws.Range("P8:P23")
Set dict = CreateObject("Scripting.Dictionary")
For Each cell In rng
If IsNumeric(cell.Value) And cell.Value <> "" Then
key = Round(cell.Value, 2)
If dict.exists(key) Then
dict(key) = dict(key) + 1
Else
dict.Add key, 1
End If
End If
Next cell
maxCount = 0
mostFrequent = 0
For Each key In dict.keys
If dict(key) > maxCount Then
maxCount = dict(key)
mostFrequent = key
ElseIf dict(key) = maxCount Then
If key < mostFrequent Then
mostFrequent = key
End If
End If
Next key
If maxCount = 0 Then
ws.Range("A1").Value = ""
Exit Sub
End If
roundedValue = Round(mostFrequent * 2, 0) / 2
ws.Range("A1").Value = roundedValue
Set dict = Nothing
Set rng = Nothing
Set ws = Nothing
End Sub