✔ Addieren von Werten die an eine Bedingung geknüpft sind

[Stef_an]

Hallo,
ich komme mal wieder nicht weiter,

ich habe eine Datenliste in der in Spalte 1 Nummern stehen die auch häufiger vorkommen können diese haben in den Spalten 8 und 9 gewisse Werte
Nun möchte ich das per Makro die Werte in Spalte 8 die in Spalte 1 die gleiche Referenz haben addiert werden, das gleiche soll in Spalte 9 durchgeführt werden.

Das Ergebnis soll in Tabelle2 ausgegeben werden und zwar in der Form das die Referenz in Spalte 1 nur noch einmal in dieser Spalte vorkommt, die Werte aus Tabelle 8 bzw. 9 aus Tabelle1 addiert in die Spalten 8 und 9 der Tabelle2 übertragen werden.

Ich habe mal einen Dummy hochgeladen in dem man den Sollzustand sieht.

P.S.: Vollständigkeitshalber:
In meiner Arbeitsdatei habe ich auf Tabelle1 einen Button der das Makro starten soll.
Die Daten werden aus einer anderen Datei gezogen und das Ergebnis soll auf Tabelle2 meiner Arbeitsdatei erscheinen. Wie ich die andere Datei ansteuere, weiss ich, muss also nicht berücksichtigt werden.

Wäre nett wenn Ihr mir helfen könntet. Mein Kopp is momentan blockiert.

Danke!

 

[Stef_an]

Hallo nochmal,
habe jetzt schon ein wenig rumprobiert allerdings wird hier nicht addiert

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False



Dim zeile1

Dim zeile2

Dim zeile3

Dim Summe

Dim Summe2



zeile1 = 2

zeile2 = 2

zeile3 = 2

Summe = 0

Summe2 = 0





Dim wb1 As Workbook

Dim ws1 As Worksheet

Set wb1 = Workbooks.Open("g:\GF-Berechnung\Datenquader_PTI13.xls")

Set ws1 = wb1.Worksheets("Sheet1")





Tabelle2.Range("A2:BT65536").Clear



ws1.Activate

Do While ws1.Cells(zeile2, 3) <> ""

   If ws1.Cells(zeile1, 3) <> ws1.Cells((zeile1) + 1, 3) Then

   Tabelle2.Cells(zeile3, 1) = ws1.Cells(zeile1, 3)

   Tabelle2.Cells(zeile3, 3) = ws1.Cells(zeile1, 8)

   Tabelle2.Cells(zeile3, 4) = ws1.Cells(zeile1, 9)

   zeile1 = zeile1 + 1

   zeile2 = zeile2 + 1

   zeile3 = zeile3 + 1

   

   Else:

   Do While ws1.Cells(zeile1, 3) = ws1.Cells((zeile1) + 1, 3)

    If ws1.Cells(zeile1, 3) = ws1.Cells((zeile1) + 1, 3) Then

         Do While ws1.Cells(zeile1, 3) = ws1.Cells((zeile1) + 1, 3)

         

         Summe = Summe + ws1.Cells(zeile1, 8)

         Summe2 = Summe2 + ws1.Cells(zeile1, 9)

         Tabelle2.Cells(zeile3, 3) = Summe

         Tabelle2.Cells(zeile3, 4) = Summe2

         

         zeile1 = zeile1 + 1

         'zeile2 = zeile2 + 1

         

                 

         Loop

         

    Else: Tabelle2.Cells(zeile3, 3) = Summe And Tabelle2.Cells(zeile3, 4) = Summe2

          zeile3 = zeile3 + 1

    End If

    

    

    

    Loop

    End If

    zeile2 = zeile2 + 1

    

    Loop

   

   

Application.ScreenUpdating = True

Tabelle2.Activate

wb1.Close

MsgBox ("Berechnung fertig")

End Sub

ich hoffe mir kann jmd helfen

Danke!

 

[Drogist]

Moin Stef_an,

ich würde die Tabelle1 mit dem Teilergebnis bearbeiten und mir die Summen aus Spalte 8 + 9 berechnen lassen.

Anschließend kannst du dann in SpalteA auf "Ergebnis" mit RIGHT(Zelle,8) prüfen. Das sind die Zeilen mit den berechneten Ergebnissen. Die Daten kannst du dann direkt in Tabelle2 schreiben oder in einem Array speichern und später schreiben.

Zum Schluss dann die Teilergebnisse wieder entfernen lassen.

... und natürlich alles in VBA. (Aufzeichnen hilf da wahrscheinlich.)

 

[tombe]

Hallo Stefan,

habe hier mal was gebastelt:

'Vorhandenen Inhalt der Tabelle2 löschen
Tabelle2.Range("A:C").Clear
'Überschriften wieder eintragen
Tabelle2.Cells(1, 1) = "Nummer"
Tabelle2.Cells(1, 2) = "fertig"
Tabelle2.Cells(1, 3) = "nicht fertig"

'Nummern aus Tabelle1 übertragen
zeile1% = 2
zeile2% = 2

Do While Tabelle1.Cells(zeile1%, 1) <> ""
    For a% = 1 To zeile2%
        If Tabelle2.Cells(a%, 1) = Tabelle1.Cells(zeile1%, 1) Then
            treffer = True
        End If
    Next a%
    If treffer = False Then
    'Nummer eintragen
        Tabelle2.Cells(zeile2%, 1) = Tabelle1.Cells(zeile1%, 1)
    'Werte für "fertig" eintragen
        Tabelle2.Cells(zeile2%, 2) = Application.WorksheetFunction.SumIf(Tabelle1.Range("A:A"), Tabelle1.Cells(zeile1%, 1), Tabelle1.Range("H:H"))
    'Werte für "nicht fertig" eintragen
        Tabelle2.Cells(zeile2%, 3) = Application.WorksheetFunction.SumIf(Tabelle1.Range("A:A"), Tabelle1.Cells(zeile1%, 1), Tabelle1.Range("I:I"))
        zeile2% = zeile2% + 1
    End If
    zeile1% = zeile1% + 1
    treffer = False
Loop

Habe in der Excel Tabelle1 auch einen Button eingefügt und den Code dann bei dem Button eingefügt.
Hänge die Excel Datei auch noch dran, dann hast du gleich alles.

 

[Stef_an]

Hallo Tombe, du bist wie immer mein Retter. Es funktioniert tadellos.