Sub MittelwertAusBereichOhneNullen()
Dim rng As Range, zaehler As Long, Zwischensumme As Double, Mittelwert As Double
For Each rng In Selection
If rng.Value 0 Then
zaehler = zaehler + 1
Zwischensumme = Zwischensumme + rng.Value
End If
Next
Mittelwert = Zwischensumme / zaehler
MsgBox Mittelwert
End Sub
Gruß
Roland Hochhäuser
Sub MittelwertAusBereichOhneNullen()
Dim Auswahl As Range, rng As Range, zaehler As Long, Zwischensumme As Double, Mittelwert As _
Double
Set Auswahl = Range("A1:A15, B2:B4") 'Anpassen
For Each rng In Auswahl
If rng.Value 0 Then
zaehler = zaehler + 1
Zwischensumme = Zwischensumme + rng.Value
End If
Next
If zaehler > 0 Then
Mittelwert = Zwischensumme / zaehler
MsgBox Mittelwert
Else
MsgBox "Kein Wert größer als 0 vorhanden, Mittelwert kann nicht gebildet werden"
End If
Set Auswahl = Nothing
End Sub
Gruß
Roland Hochhäuser
Sub Makro1()
Dim dblMW As Double
dblMW = Evaluate("=SUM(A2:A15)/COUNTIF(A2:A15,""0"")")
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Sub Makro2()
Dim dblMW As Double
dblMW = WorksheetFunction.Sum(Range("A2:A15")) / _
WorksheetFunction.CountIf(Range("A2:A15"), "0")
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort