AW: Häufigkeit (Favoriten-Anzeige)
02.01.2004 13:52:55
Martin Beck
Hallo Bernd,
versuche mal die benutzerdefinierten Funktionen:
Function Haeufigster_Wert(Bereich As Range)
'Berechnet den häufigsten Wert in einem Bereich.
ez = Bereich.Cells(1).Row
lz = Bereich.Cells(Bereich.Cells.Count).Row
y = 0
For i = ez To lz
x = WorksheetFunction.CountIf(Bereich, Bereich.Cells(i))
If x > y Then
y = x
Haeufigster_Wert = Bereich.Cells(i).Value
End If
Next i
End Function
Function N_Haeufigster_Wert(Bereich As Range, n As Integer)
'Berechnet den N-häufigsten Wert in einem Bereich.
Dim arrInhalt()
Dim arrHäuf()
Dim arrHäufEin()
Dim arrInhaltEin()
ez = Bereich.Cells(1).Row
lz = Bereich.Cells(Bereich.Cells.Count).Row
Z = lz - ez + 1
ReDim arrInhalt(Z)
ReDim arrHäuf(Z)
ReDim arrHäufEin(Z)
ReDim arrInhaltEin(Z)
y = 0
For i = ez To lz
x = WorksheetFunction.CountIf(Bereich, Bereich.Cells(i))
arrInhalt(i - ez + 1) = Bereich.Cells(i).Value
arrHäuf(i - ez + 1) = x
'MsgBox arrInhalt(i - ez + 1)
Next i
For M = 1 To Z - 1
For k = M + 1 To Z
If arrHäuf(M) < arrHäuf(k) Then
h = arrHäuf(M): arrHäuf(M) = arrHäuf(k): arrHäuf(k) = h
G = arrInhalt(M): arrInhalt(M) = arrInhalt(k): arrInhalt(k) = G
End If
Next
Next
For s = 1 To Z - 1
For T = s + 1 To Z
If arrHäuf(s) = arrHäuf(T) And arrInhalt(s) < arrInhalt(T) Then
e = arrHäuf(s): arrHäuf(s) = arrHäuf(T): arrHäuf(T) = e
f = arrInhalt(s): arrInhalt(s) = arrInhalt(T): arrInhalt(T) = f
End If
Next
Next
w = 1
For j = 1 To Z - 1
If arrHäuf(j) > arrHäuf(j + 1) Or (arrHäuf(j) = arrHäuf(j + 1) And arrInhalt(j) <> arrInhalt(j + 1)) Then
arrHäufEin(w) = arrHäuf(j)
arrInhaltEin(w) = arrInhalt(j)
w = w + 1
End If
Next j
If arrHäuf(Z) <> 0 Then
arrInhaltEin(w) = arrInhalt(Z)
End If
If w < n Then
N_Haeufigster_Wert = CVErr(xlErrNA)
Else
N_Haeufigster_Wert = arrInhaltEin(n)
End If
End Function
Gruß
Martin Beck