Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1524to1528
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Blockweise Mittelwert bilden und in neue Tab.

VBA: Blockweise Mittelwert bilden und in neue Tab.
23.11.2016 14:32:26
Conrad
Hallo zusammen,
ich komme bei meinem Problem leider nicht weiter.
Ich muss aus einer Tabelle mit mehreren Spalten und etwas 30.000 Zeilen, alle 6 Zeilen einen _
Mittelwert bilden. Diesen würde ich dann anschließend gerne in ein neues Tabellenblatt _ schreiben lassen, sodass eine "kompimierte Tabelle" entsteht. Bei dem Versuch habe ich Testweise nur eine Spalte genommen, soll aber generell für mehrere laufen.

Sub Mittelwert()
Dim wksArbeitsblatt As Worksheet
Dim wksZielblatt As Worksheet
Dim rngBereich As Range
Dim dblMittelwert As Double
Dim dblZelleRowZielblatt As Double
Dim lngZelleRowArbeitsblatt As Long
Set wksArbeitsblatt = tblBasisdaten
Set wksZielblatt = tblZieldaten
Set dblZelleRowZielblatt = ActiveWorkbook.wksZielblatt.Cells.Row
Set lngZelleRowArbeitsblatt = ActiveWorkbook.wksArbeitsblatt.Cells.Rows
Set rngBereich = wksArbeitsblatt.Range(wksArbeitsblatt.Cells(lngZelleRowArbeitsblatt, 1), _
wksArbeitsblatt.Cells(lngZelleRowArbeitsblatt + 5, 1))
With dblZelleRowZielblatt = 1
For lngZelleRowArbeitsblatt = 2 To 50000 Step 6
dblMittelwert = Application.WorksheetFunction.AverageIf(rngBereich, ">0")
wksZielblatt.Cells(dblZelleRowZielblatt, 1) = dblMittelwert
dblZelleRowZielblatt = dblZelleRowZielblatt + 1
Next lngZelleRowArbeitsblatt
End With
End Sub

Vielen Dank
mfG
Conrad

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA: Blockweise Mittelwert bilden und in neue Tab.
23.11.2016 16:25:27
Michael
Hallo!
Gibt Dir die Mittelwerte aller 6-zeiligen Blöcke von Tabelle1 in Spalte A der Tabelle2 aus:
Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook 'In DIESER Arbeitsmappe
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1") 'Quell-Blatt mit Daten
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2") 'Ziel-Blatt für Mittelwerte
Dim Daten As Range, Block As Range, i As Long
With WsQ
Set Daten = .Range(.Cells(2, 1), .Cells(.Rows.Count, 5).End(xlUp))
With Daten
For i = 1 To .Rows.Count Step 6
Set Block = .Range(.Cells(i - 1, 1), .Cells(i + 4, 5))
With WsZ
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = _
WorksheetFunction.Average(Block)
End With
Set Block = Nothing
Next i
End With
End With
End Sub
In diesem Fall umfasst der Quelldaten-Bereich (bei mir) die Spalten A:E, also 5 (die Zeilen-Länge wird ebenfalls über die 5. Spalte bestimmt). Solltest Du mehr Spalten haben, müsstest Du hier entsprechend anpassen:
Set Daten = .Range(.Cells(2, 1), .Cells(.Rows.Count, 5).End(xlUp))
Ich habe es so verstanden, dass der MW jeweils von allen Zahlen im jeweiligen Block gerechnet werden soll: also zB von allen Zahlen in den Zellen A2:E7 bspw.; falls nicht müsstest Du konkretisieren, worum's Dir geht.
LG
Michael
Anzeige
AW: VBA: Blockweise Mittelwert bilden und in neue Tab.
23.11.2016 17:36:19
Conrad
Hallo Michael,
erst einmal vielen Dank, es funktionert schon sehr gut! Ich habe es zwar so gemeint, dass die Mittelwerte Spaltenweise (in 6er Blocks) gezogen werden, aber das sollte ich auch selbst hinbekommen.
MfG
Conrad
OK, viel Erfolg! Hier noch 2 Varianten...
24.11.2016 12:31:22
Michael
Conrad,
...für Dich, falls es Dich interessiert:
Hier noch eine Variante für den oben gezeigten Code, der statt mit dem Bereich mit einem Array arbeitet (hier wieder für 6-zeilige,5-spaltige Blöcke); könnte uU noch etwas schneller laufen als der o.a. Code:
Sub b()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1")
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2")
Dim Daten As Range
Dim a, b As New Collection, c
Dim i As Long, j As Long, k As Long, l As Long
With WsQ
Set Daten = .Range(.Cells(2, 1), .Cells(.Rows.Count, 5).End(xlUp))
a = Daten
For i = LBound(a) To UBound(a) Step 6
For j = i To i + 5: For k = 1 To 5: b.Add a(j, k): Next k: Next j
ReDim c(0 To b.Count - 1): For l = 1 To b.Count: c(l - 1) = b.Item(l): Next l
With WsZ
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = WorksheetFunction.Average(c)
End With
Do Until b.Count = 0: b.Remove 1: Loop: Erase c
Next i
End With
End Sub
Hier zwei Varianten (einmal mit Bereichen, einmal mit Array/Collection) allerdings bezogen auf jeweils 6-zeilige, aber nur 1-spaltige (!) MW-Blöcke, wie von Dir eigentlich gewünscht:
Sub c()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1")
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2")
Dim Daten As Range, Block As Range, i As Long, j As Long
With WsQ
Set Daten = .Range(.Cells(2, 1), .Cells(.Rows.Count, 5).End(xlUp))
With Daten
For i = 1 To .Rows.Count Step 6
For j = 1 To .Columns.Count
Set Block = .Range(.Cells(i - 1, j), .Cells(i + 4, j))
With WsZ
.Cells(.Rows.Count, j).End(xlUp).Offset(1, 0) = _
WorksheetFunction.Average(Block)
End With
Set Block = Nothing
Next j
Next i
End With
End With
End Sub

Sub d()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1")
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2")
Dim Daten As Range
Dim a, b As New Collection, c
Dim i As Long, j As Long, k As Long, l As Long
With WsQ
Set Daten = .Range(.Cells(2, 1), .Cells(.Rows.Count, 5).End(xlUp))
a = Daten
For i = LBound(a) To UBound(a) Step 6
For j = 1 To 5
For k = i To i + 5
b.Add a(k, j)
Next k
ReDim c(0 To b.Count - 1): For l = 1 To b.Count: c(l - 1) = b.Item(l): Next l
With WsZ
.Cells(.Rows.Count, j).End(xlUp).Offset(1, 0) = WorksheetFunction.Average(c)
End With
Do Until b.Count = 0: b.Remove 1: Loop: Erase c
Next j
Next i
End With
End Sub
Evtl. kannst Du's ja brauchen.
LG
Michael
Anzeige
AW: ein Ansatz?
23.11.2016 16:25:38
Fennek
Hallo,
eine mögliche Idee:
in einer Hilfspalte die Formel
=Ganzzahl(zeile()/6)
eingeben und mit autofill auf alle 30.000 Zeilen anwenden.
Dann eine Pivot-Tabelle anlegen mit der Hilfsspalte als Kriterium und für die Werte "Mittelwert" einstellen.
mfg

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige