Daten zusammenfassen nach Blöcken

Forumthread: Daten zusammenfassen nach Blöcken
5 Beiträge zu diesem Forumthread
Anzeige
32 Threads zu ähnlichen Themen
VBA Beispiele zu verwandten Themen
Top 100 Forumthreads

Forumthread: Daten zusammenfassen nach Blöcken

Lucia

Hallo zusammen,
Ich habe folgende Herausforderung:
In einer sind in einer Spalte Daten aufgelistet. Von diesen haben einige den Wert 0, nach ein paar Zeilen beginnt jedoch ein Block mit Werten größer null. Der geht einige Zeilen bis wieder eine Reihe mit "0-Zeilen" kommt.
Dieser Block stellt einen "run" dar, der mit einer fortlaufenden Nummer versehen werden soll (Spalte B). In Spalte C wird die Summe der Werte aus diesem Block gebildet; in Spalte D der Mittelwert.
Hier das Beispiel:
https://www.herber.de/bbs/user/67537.xls
Da es sich um verdammt viele Daten handelt würde ich das gerne mit einem Makro machen (händisch wäre ich, nach meiner Hochrechung gestern nach 45 Stunde fertig mit allen Daten und könnte mich anschließend einweisen lassen.)
Ich hoffe ihr könnt mir weiterhelfen:-)
Gruß,
Lucia

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Daten zusammenfassen nach Blöcken

Beverly
AW: Daten zusammenfassen nach Blöcken

Lucia
Formellösung

Rudi
AW: Formellösung

Lucia
hier meine Version.

Tino

AW: Daten zusammenfassen nach Blöcken

27.01.2010 10:43:46

Beverly

Hi Lucia,
vielleicht eine Möglichkeit:

Sub RoutineEintragen()
Dim loZeile1 As Long
Dim loZeile2 As Long
Dim loZaehler As Long
loZaehler = 1
loZeile1 = 2
Do
If Cells(loZeile1, 1)  0 Then
loZeile2 = loZeile1
Do
If Cells(loZeile1 + 1, 1) = 0 Then
Cells(loZeile1, 2) = loZaehler
Cells(loZeile1, 3).FormulaLocal = "=SUMME(A" & loZeile2 & ":A" & loZeile1 &  _
")"
Cells(loZeile1, 4).FormulaLocal = "=MITTELWERT(A" & loZeile2 & ":A" &  _
loZeile1 & ")"
loZaehler = loZaehler + 1
End If
loZeile1 = loZeile1 + 1
Loop While Cells(loZeile1, 1)  0
loZeile1 = loZeile1 - 1
End If
loZeile1 = loZeile1 + 1
Loop While Cells(loZeile1, 1)  ""
End Sub

AW: Daten zusammenfassen nach Blöcken

27.01.2010 11:13:53

Lucia

Hi Karin,
Die perfekte Lösung!!
Vielen Dank!

Formellösung

27.01.2010 10:46:36

Rudi

Hallo,
dafür braucht man kein VBA.
in B2: 1
in B3: =WENN(UND(A3=0;A20);B2+1;B2) und runterkopieren
in C2: =WENN(B3B2;SUMMEWENN(B:B;B2;A:A);"") und runterkopieren
in D2: =WENN(B3B2;C2/SUMMENPRODUKT(($B$2:B2=B2)*($A$2:A20));"") und runterkopieren
Gruß
Rudi

AW: Formellösung

27.01.2010 11:16:11

Lucia

Hi Rudi,
Jo...das is auch kein schlechtre Ansatz. Ich hab jetzt trotzdem mal die Lösung von Karin genommen, aus einem Grund: Teilweise handelt es sich um Dateien mit bis 50.000 Zeilen. Das wird dann richtig viel...
Aber vielen Dank, ich werde die Formellösung sicher noch für einen anderen Einsatz brauchen!!
Gruß,
Lucia

hier meine Version.

27.01.2010 11:00:42

Tino

Hallo,

Sub test()
Dim meAr(), tmpAr()
Dim A&, AA&, AAA&, Korrektur&
Dim dSumme As Double, LCounter&
Dim booErg As Boolean, Letzter&
meAr() = Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value2
ReDim tmpAr(1 To UBound(meAr), 1 To 3)
Korrektur = 1
For A = 1 To UBound(meAr)
If meAr(A, 1)  0 Then
For AA = A To UBound(meAr)
If AA  0 Or AA = UBound(meAr) Then
LCounter = LCounter + 1
dSumme = dSumme + meAr(AA, 1)
booErg = AA = UBound(meAr)
Else
booErg = True
End If
Else
booErg = True
End If
If booErg Then
If AA = UBound(meAr) Then Korrektur = 0
AAA = AAA + 1
tmpAr(AA - Korrektur, 1) = AAA 'Nummer
tmpAr(AA - Korrektur, 2) = dSumme 'Summe
tmpAr(AA - Korrektur, 3) = dSumme / LCounter 'Mittelwert
dSumme = 0: LCounter = 0
A = AA
booErg = False
Exit For
End If
Next AA
End If
Next A
Range("B2").Resize(UBound(tmpAr), UBound(tmpAr, 2)) = tmpAr
End Sub

Gruß Tino

;