Mittelwert - mehrere Kriterien in einer Spalte

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

…bestimmten Bedingungen nicht so fktt wie von mir erwartet, weshalb eine Initialisierung der Zähler sz und zz mit 1 erforderlich ist und das an beiden Stellen nach On Error Resume Next (die ersten beiden Auftritte dieser Anweisung). Da auch noch ein Hinweis im Vorspann dazukommt, hier nochmals der komplette PgmCode der Version 1.3, womit die Link-Kette von den 1.Versionen bis hierher abgeschlossen wäre: Rem Aggregat f.1 Datenfeld aus Ausdruck (eXpression) ' als Arg3 u.ggf eines als Arg4 f.Arg1>13; Umwandl ' 1es Bereichs in DatFeld; nur Input-FWert-Ignorg! ' Arg1: 0|"") bzw FWt-Ersatz durch ""/1 b.Arg2=8/9; ' Arg3: ZBer/Ausdr->DFeld; Arg4: ohne/Kl13. ' Achtung! Neg Arg1 vhindrt ext FmlText-Evaluierg! ' Vs1.3 -LSr -cd:20160120 -1pub:20160120herber -lupd:20160129t Function AggregateXk(ByVal Funktion As Integer, ByVal Optionen As Integer, _ ByVal DatenfeldAusdruck, Optional ByVal k) Const myName$ = "aggregatexk(" Dim p As Long, sx As Long, sz As Long, zx As Long, zz As Long, _ q(1) As Long, FTxt As String, erg, kw, xw, zwErg As Variant On Error GoTo fx If Funktion 'FmlTxtAuswert f.entsprd FmlTeil (nur 1×!) Application.Volatile: AggregateXk = Now FTxt = "(-" & Split(LCase(Application.ThisCell.Formula), myName)(1) For p = 1 To Len(FTxt) q(0) = q(0) - CInt(Mid(FTxt, p, 1) = "(") q(1) = q(1) - CInt(Mid(FTxt, p, 1) = ")") If q(1) = q(0) Then Exit For Next p FTxt = myName & Mid(FTxt, 2, p - 1 + CInt(p > Len(FTxt))) AggregateXk = ActiveSheet.Evaluate(FTxt): Exit Function End If With WorksheetFunction If TypeName(DatenfeldAusdruck) = "Range" Then If DatenfeldAusdruck.Cells.Count > 1 Then DatenfeldAusdruck = .Transpose(.Transpose(DatenfeldAusdruck)) Else: DatenfeldAusdruck = Array(DatenfeldAusdruck) End If End If If Not IsMissing(k) Then If TypeName(k) = "Range" Then If k.Cells.Count > 1 Then k = .Transpose(.Transpose(k)) End If End If End With On Error Resume Next: sz = 1: zz = 1 sz = UBound(DatenfeldAusdruck, 2) + 1 - LBound(DatenfeldAusdruck, 2) zz = UBound(DatenfeldAusdruck, 1) + 1 - LBound(DatenfeldAusdruck, 1) On Error GoTo fx: ReDim zwErg(zz - 1, sz - 1) Select Case Optionen Case 0, 1, 4, 5 'entfällt hier f.DFeld! zwErg = DatenfeldAusdruck Case 2, 3, 6, 7, 8, 9 'dito, nur FWertErsatz! For Each xw In DatenfeldAusdruck If Not IsError(xw) Then zwErg(zx, sx) = xw ElseIf Optionen > 7 Then zwErg(zx, sx) = Array("", 1)(Optionen - 8) End If zx = (zx + 1) Mod zz: sx = sx - CInt(zx = 0) Next xw Case Else: Err.Raise xlErrNA End Select With Application If Funktion > 13 And IsArray(k) Then On Error Resume Next: sz = 1: zz = 1 sz = UBound(k, 2) + 1 - LBound(k, 2) zz = UBound(k, 1) + 1 - LBound(k, 1) On Error GoTo fx kw = k: zx = 0: sx = 0: ReDim erg(zz - 1, sz - 1) For Each k In kw On Error Resume Next: GoSub kf: On Error GoTo fx erg(zx, sx) = AggregateXk: AggregateXk = Empty zx = (zx + 1) Mod zz: sx = sx - CInt(zx = 0) Next k AggregateXk = erg: Exit Function End If kf: Select Case Funktion Case 0: AggregateXk = zwErg Case 1: AggregateXk = .Average(zwErg) Case 2: AggregateXk = .Count(zwErg) Case 3: AggregateXk = .CountA(zwErg) Case 4: AggregateXk = .Max(zwErg) Case 5: AggregateXk = .Min(zwErg) Case 6: AggregateXk = .Product(zwErg) Case 7: AggregateXk = .StDev_S(zwErg) Case 8: AggregateXk = .StDev_P(zwErg) Case 9: AggregateXk = .Sum(zwErg) Case 10: AggregateXk = .Var_S(zwErg) Case 11: AggregateXk = .Var_P(zwErg) Case 12: AggregateXk = .Median(zwErg) Case 13: AggregateXk = .Mode_Sngl(zwErg) Case 14: AggregateXk = .Large(zwErg, k) Case 15: AggregateXk = .Small(zwErg, k) Case 16: AggregateXk = .Percentile_Inc(zwErg, k) Case 17: AggregateXk = .Quartile_Inc(zwErg, k) Case 18: AggregateXk = .Percentile_Exc(zwErg, k) Case 19: AggregateXk = .Quartile_Exc(zwErg, k) Case Else: Err.Raise xlErrNA End Select If Not IsEmpty(kw) Then Return End With fx: If CBool(Err.Number) Then AggregateXk = CVErr(Err.Number) End Function Luc :-?

Beliebteste Forumthreads (12 Monate)

Mittelwert - mehrere Kriterien in einer Spalte

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

271 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

	A	B	C
1	1	1	3,667
2	2	2
3	3	5
4	4	4
5	5	5
6	6	1
7	7	2
8	8	3
9	9	4
10	10	5
11	11	4
12	10	3
13	2	3
14	3	4
15

Mittelwert - mehrere Kriterien in einer Spalte

21 Beiträge zum Forumthread Beiträge zu diesem Forumthread

271 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread