title image


Smiley Teilergebnisse selbst erstellen mit VBA
hallo,



ich habe in erinnerung, dass es eine Grenze bei der Anzahl der Teilergebnisse gibt.

ich habe mal vor einigen jahren ein ähnliches problem gepostet und meine, dass die antwort sinngemäß war, dass es keine grenze gibt, die in excel liegt sondern was mit dem rechner zu tun hat (stapelüberlauf oder sonstige für mich unverständliche dinge).



daneben ist auch die laufzeit überproportional gestiegen wenn es mehr teilergebnisse wurden. ggf. kannst du die teilergebnisse selbst mit vba einfügen wenn du auf die gliederungsklammern auf der linken seite verzichten kannst?



in meinem beispiel wird nach spalte a gegliedert und die summe für spalte b gebildet. der code ist gemacht um teilergebnisse zu bilden und falls welche vorhanden sind diese auch wieder zu entfernen.





Sub teilergbnisse()

Application.ScreenUpdating = False

    'wenn Teilergebnisse vorhanden sind steht in der letzen Zeile der Spalte A "Gesamtsumme"

    If Cells([a65536].End(xlUp).Row, 1) = "Gesamtsumme" Then

        'Letzte Zeile löschen

        Rows([a65536].End(xlUp).Row).Delete

        'Alle Zeilen mit Zwischensummen löschen

        For i = [a65536].End(xlUp).Row To 1 Step -1

            If Left(Cells(i, 1), 8) = "Ergebnis" Then Rows(i).Delete

        Next

    'wenn keine Teilergebnisse vorhanden sind dann welche einfügen

    Else

        Dim ZwErg As Long

        'Variable für Ermittlung Bereich bis letztes Zwischenergebnis

        ZwErg = 2

        For i = 2 To 65536

            'wenn Gruppierungswechsel vorhanden dann

            If Cells(i + 1, 1) <> Cells(i, 1) Or Cells(i + 1, 1) = "" Then

                'Zeile einfügen

                Rows(i + 1).Insert

                'Spalte A beschriften mit Ergebnis und dem Wertebereich

                Cells(i + 1, 1) = "Ergebnis " & Cells(i, 1)

                'Spalte B Summenformel bis zum letzten Teilergebnis

                Cells(i + 1, 2).Formula = "=SUM(" & Range(Cells(ZwErg, 2), Cells(i, 2)).Address(False, False, xlA1) & ")"

                'Zähler wegen der eingefügten Zeile um 1 erhöhen

                i = i + 1

                'Variable für Zwischensumme neu setzen

                ZwErg = i + 1

            End If

            'Schleife verlassen wenn keine Werte mehr vorhanden

            If Cells(i + 1, 1) = "" Then Exit For

        Next

        'Summenformel für Gesamtergebnis. Division durch 2 wegen der Teilergebnisse

        Cells([b65536].End(xlUp).Row + 1, 2).Formula = _

        "=SUM(" & Range(Cells(2, 2), Cells([b65536].End(xlUp).Row, 2)).Address(False, False, xlA1) & ")/2"

        'Formel "beschriften"

        Cells([b65536].End(xlUp).Row, 1) = "Gesamtsumme"

    End If

Application.ScreenUpdating = True

End Sub



 Code eingefügt mit Syntaxhighlighter 1.16



liebe grüsse georg
Beiträge zu Excel 2002 in Verbindung mit Win XP

 A
1Tabellentool
2von StrgAltEntf


Gibts hier


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: