Herbers Excel/VBA-Archiv

Daten zusammenfassen nach Blöcken | Herbers Excel-Forum

• Daten zusammenfassen nach Blöcken von Lucia vom 27.01.2010 10:07:09
• AW: Daten zusammenfassen nach Blöcken - von Beverly am 27.01.2010 10:43:46
  • AW: Daten zusammenfassen nach Blöcken - von Lucia am 27.01.2010 11:13:53
• Formellösung - von Rudi Maintaire am 27.01.2010 10:46:36
  • AW: Formellösung - von Lucia am 27.01.2010 11:16:11
• hier meine Version. - von Tino am 27.01.2010 11:00:42

Betrifft: Daten zusammenfassen nach Blöcken von: Lucia
Geschrieben am: 27.01.2010 10:07:09

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

Betrifft: AW: Daten zusammenfassen nach Blöcken von: Beverly
Geschrieben am: 27.01.2010 10:43:46

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

---

Betrifft: AW: Daten zusammenfassen nach Blöcken von: Lucia
Geschrieben am: 27.01.2010 11:13:53

Hi Karin,

Die perfekte Lösung!!
Vielen Dank!

Betrifft: Formellösung von: Rudi Maintaire
Geschrieben am: 27.01.2010 10:46:36

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

Gruß
Rudi

Betrifft: AW: Formellösung von: Lucia
Geschrieben am: 27.01.2010 11:16:11

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

Betrifft: hier meine Version. von: Tino
Geschrieben am: 27.01.2010 11:00:42

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 <= UBound(meAr) Then
               If meAr(AA, 1) <> 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

Beiträge aus den Excel-Beispielen zum Thema "Daten zusammenfassen nach Blöcken"