Thema Datum  Von Nutzer Rating
Antwort
04.03.2025 14:55:25 Timo
NotSolved
Blau der etwas andere Mittelwert...
 05.03.2025 13:29:58 cysu11
Solved
07.03.2025 08:48:22 Timo
NotSolved
06.03.2025 16:50:51 Gast7777
NotSolved

Ansicht des Beitrags:
Von:
cysu11		 Datum:
05.03.2025 13:29:58		 Views:
30		 Rating:
     
Antwort:
 Nein
Thema:
der etwas andere Mittelwert...

Hi Timo,

probiere mal so:

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) ' Anpassen, falls anderes Sheet genutzt wird
    Set rng = ws.Range("P8:P23")
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' Werte einlesen und Häufigkeit ermitteln
    For Each cell In rng
        If IsNumeric(cell.Value) And cell.Value <> "" Then
            key = Round(cell.Value, 2) ' Auf 2 Nachkommastellen runden
            If dict.exists(key) Then
                dict(key) = dict(key) + 1
            Else
                dict.Add key, 1
            End If
        End If
    Next cell
    
    ' Häufigste Zahl bestimmen
    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
            ' Falls Gleichstand, kleineren Wert nehmen
            If key < mostFrequent Then
                mostFrequent = key
            End If
        End If
    Next key
    
    ' Falls keine Zahl gefunden wurde, abbrechen
    If maxCount = 0 Then
        ws.Range("A1").Value = ""
        Exit Sub
    End If
    
    ' Rundung auf 0,5er Schritte
    roundedValue = Round(mostFrequent * 2, 0) / 2
    
    ' Ergebnis in A1 schreiben
    ws.Range("A1").Value = roundedValue
    
    ' Objekte freigeben
    Set dict = Nothing
    Set rng = Nothing
    Set ws = Nothing
End Sub

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
04.03.2025 14:55:25 Timo
NotSolved
Blau der etwas andere Mittelwert...
 05.03.2025 13:29:58 cysu11
Solved
07.03.2025 08:48:22 Timo
NotSolved
06.03.2025 16:50:51 Gast7777
NotSolved