title image


Smiley Teilergebniss erstellen mit VBA Rel.1.1
Hallo Jens Claus,



ich glaube du wünscht etwas anderes als das was Teilergebnisse "macht". Teilergebnisse durchläuft Daten EINER Spalte, gibt es einen "Wechsel" wird eine Leerzeile eingefügt, der Wert (bei dir ist es die "02") als "02 Summe" in die neue Zeile geschrieben und in der von dir gewählten Spalte wird noch die Summe gebildet. Wenn Du z.b. "Müller" in dieser Zeile stehen haben möchtest, dann müsstest du auch nach dieser Spalte gruppieren.



Alternativ kannst Du ein Makro verwenden das diese Aufgabe erledigt. Ich habe mal das folgende Makro geschrieben, weil es deutlich performanter ist als "Teilergebnisse". Es war für die Verwendung in grossen TAbellen. So sieht meine Mustertabelle aus:



 ABC1Pers.Nr.NameWert22Müller132Müller142Müller152Müller162Müller271Meyer281Meyer491Meyer3101Meyer3113Schulze3123Schulze34133Schulze5143Schulze4



Dieser Code:







      

Sub teilergbnisse()

Dim SumSp As Long

Dim GrupSp As Long

SumSp = 3 ' Summenspalte definieren ggf. variabel abfragen

GrupSp = 1 'Gruppierungsspalte definieren, ggf. varabel abfragen

Application.ScreenUpdating = False

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

    If Cells(Cells(65536, GrupSp).End(xlUp).Row, GrupSp) = "Gesamtsumme" Then

        'Letzte Zeile löschen

        Range("A1").ClearOutline

        Rows(Cells(65536, GrupSp).End(xlUp).Row).Delete

        'Alle Zeilen mit Zwischensummen löschen

        For i = Cells(65536, GrupSp).End(xlUp).Row To 1 Step -1

            If Left(Cells(i, GrupSp), 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, GrupSp) <> Cells(i, GrupSp) Or Cells(i + 1, GrupSp) = "" Then

                'Zeile einfügen

                Rows(i + 1).Insert

                'Spalte A beschriften mit Ergebnis und dem Wertebereich + dem Namen

                Cells(i + 1, GrupSp) = "Ergebnis " & Cells(i, GrupSp) & " / " & Cells(i, 2) 'String kann beiliebig "zusammengebaut" werden

                'Spalte C Summenformel bis zum letzten Teilergebnis

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

                Rows(i + 1).Font.Bold = True

'                Range(Cells(ZwErg, 1).Address, Cells(i, 1).Address).Rows.Group

                '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, GrupSp) = "" Then Exit For

        Next

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

        Cells(Cells(65536, GrupSp).End(xlUp).Row + 1, SumSp).Formula = _

        "=SUM(" & Range(Cells(2, SumSp), Cells(Cells(65536, GrupSp).End(xlUp).Row, SumSp)).Address(False, False, xlA1) & ")/2"

        'Formel "beschriften"

        Cells(Cells(65536, GrupSp).End(xlUp).Row + 1, GrupSp) = "Gesamtsumme"

        Rows(Cells(65536, GrupSp).End(xlUp).Row).Font.Bold = True

        Range("A1").AutoOutline 'Gliederungsklammern einfügen

    End If

Application.ScreenUpdating = True

End Sub 





Code eingefügt mit Syntaxhighlighter 3.0







fügt die Teilergebnisse ein. Suche mal nach "zusammengebaut" im Code. In dieser Zeile kannst du die Bezeichnung beliebig schaffen.



Das Ergebnis in meinem Beispiel:



 ABC1Pers.Nr.NameWert22Müller132Müller142Müller152Müller162Müller27Ergebnis 2 / Müller 681Meyer291Meyer4101Meyer3111Meyer312Ergebnis 1 / Meyer 12133Schulze3143Schulze34153Schulze5163Schulze417Ergebnis 3 / Schulze 4618Gesamtsumme 64



Vielleicht bringt dich das weiter?



LG 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: