gleiche Inhalte summieren



Excel-Version: 8.0 (Office 97)
nach unten

Betrifft: gleiche Inhalte summieren
von: Stephan
Geschrieben am: 15.05.2002 - 16:19:26

Hallo,

Ich habe folgendes Problem:
Ich habe eine Liste mit 2 Spalten, in der 1. Spalte Abteilungen, in der 2. Spalte Werte. Jetzt möchte ich in dieser Liste die Werte einer Abteilung addieren und das summierte Ergebnis behalten, die anderen Einträge dieser Abteilung sollen rausfliegen.
Wie ist das mit VBA möglich?

nach oben   nach unten

Re: gleiche Inhalte summieren
von: Klaus Schubert
Geschrieben am: 15.05.2002 - 21:58:30

Hallo Stephan,

klicke in deiner Spalte A einen Abteilungsnamen an und führe dann folgenden Code aus.
Es ist dabei egal. in welcher Zeile der Abteilungsname steht, es bleibt immer der erste Eintrag mit der Summe erhalten:


Sub WerteVonAbteilungSummieren()
Dim LetzteZeile As Integer, Zähler As Integer, SummeWerte As Single
Dim Abteilung As String, ErsterTreffer As Boolean

If ActiveCell.Column <> 1 Then Exit Sub

ErsterTreffer = False
Abteilung = ActiveCell.Value
LetzteZeile = ActiveSheet.UsedRange.Rows.Count

For Zähler = 2 To LetzteZeile

If Cells(Zähler, 1) = Abteilung Then
If ErsterTreffer = False Then Cells(Zähler, 1).Activate: ErsterTreffer = True
SummeWerte = SummeWerte + Cells(Zähler, 2).Value
If Zähler <> ActiveCell.Row Then Rows(Zähler).Delete: Zähler = Zähler - 1
End If

Next Zähler

With ActiveCell
.Offset(0, 1) = SummeWerte
.Font.Bold = True
.Offset(0, 1).Font.Bold = True
End With

End Sub


Die summierte Abteilung erscheint nach der Prozedur in Fettschrift, 
damit mann weiß, das der Vorgang für diese Abteilung abgeschlossen ist. 
Alle anderen Zeilen mit dem selben Abteilungsnamen werden gelöscht 
(Es wird immer die komplette Zeile gelöscht !!!).
Sind deine Abteilungsnamen nicht in Spalte 1(=A) , dann mußt du folgende Codezeile entsprechend anpasssen

If ActiveCell.Column <> 1 Then Exit Sub '(1 = Spalte A , 2 = Spalte B , usw.)

Ich hoffe , es war das, was du wolltest.
Gruß Klaus


nach oben   nach unten

Re: gleiche Inhalte summieren
von: Stephan
Geschrieben am: 16.05.2002 - 10:21:02

Ja, das schaut schon nicht schlecht aus.
Geht das auch, ohne dass ich eine Abteilung markieren muss, sondern dass einfach von oben nach unten durchgelaufen und summiert wird?

Gruß,
Stephan


nach oben   nach unten

Re: gleiche Inhalte summieren
von: Klaus Schubert
Geschrieben am: 16.05.2002 - 20:23:59

Hallo Stephan,

versuch's mal hiermit.Es dürfen allerdings keine Leerzellen zwischen den Abteilungsnamen sein, da die Routine sonst abbricht.


Sub WerteVonAbteilungSummieren()
Dim LetzteZeile As Integer, Zähler1 As Integer, Zähler2 As Integer, SummeWerte As Single
Dim Abteilung As String, ErsterTreffer As Boolean

Application.ScreenUpdating = False

LetzteZeile = ActiveSheet.UsedRange.Rows.Count

For Zähler1 = 2 To LetzteZeile

    ErsterTreffer = False
    SummeWerte = 0
    Abteilung = Cells(Zähler1, 1).Value
    
    If Abteilung = "" Then Exit Sub
    
        For Zähler2 = 2 To LetzteZeile
        
        If Cells(Zähler2, 1) = Abteilung Then
        If ErsterTreffer = False Then Cells(Zähler2, 1).Activate: ErsterTreffer = True
        SummeWerte = SummeWerte + Cells(Zähler2, 2).Value
        If Zähler2 <> ActiveCell.Row Then Rows(Zähler2).Delete: Zähler2 = Zähler2 - 1
        End If
        
        Next Zähler2
    
    With ActiveCell
    .Offset(0, 1) = SummeWerte
    .Font.Bold = True
    .Offset(0, 1).Font.Bold = True
    End With

Next Zähler1

Application.ScreenUpdating = True
End Sub

Gruß Klaus

 nach oben

Beiträge aus den Excel-Beispielen zum Thema "gleiche Inhalte summieren"