Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 14:03:38
Http-Request (POST) für GraphQL API-Abfrage
20.04.2024 08:56:18
Textbox in Tabellenblatt ohne Bestätigung in Zelle eintragen
20.04.2024 07:57:54
Tablle fürs E-Auto - Preis wenn kürzer als 60 Min Ladezeit
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1132to1136
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1132to1136
1132to1136
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Daten zusammenfassen nach Blöcken

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
Anzeige
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


Anzeige
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
Anzeige
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige