Office: Doppler finden, addieren, löschen ("Mit Sonderwünschen&

Hallo zusammen,

Ich bin momentan dabei eine Exceldatei zu erstellen welche diverse Formel und Makros umfasst und stoße als nicht Programmierer so langsam an meine Grenzen.
Ich würde gerne nachfolgendes Problem mit einem VBA-Code lösen:

Bestehende Tabelle (Beispiel):
A-----B---------C-----D-----E-----F (Spalten)

1-----Porsche-1-----1-----A-----0,5
2----------------1-----1-----A-----0,5
3----------------1-----2-----A-----0,5
4----------------1-----2-----B-----0,5
5-----Audi------2-----1-----A-----0,5
6----------------2-----1-----A-----0,5
7----------------2-----2-----A-----0,5
8----------------2-----2-----B-----0,5

So soll das ganze im Ergebnis aussehen:
A-----B---------C-----D-----E-----F (Spalten)

1-----Porsche-1-----1-----A-----1,0
3----------------1-----2-----A-----0,5
4----------------1-----2-----B-----0,5
5-----Audi------2-----1-----A-----1,0
7----------------2-----2-----A-----0,5
8----------------2-----2-----B-----0,5

Es soll also der Zeileneintrag in Spalte B,C und D verglichen werden. Wenn diese gleich sind dann soll die Spalte E addiert werden und die Doppler (2er,3er,4er....(Ganz wichtig, da der Autoname bestehen bleiben soll/Spalte B ist quasi die Artikelnummer)) gelöscht werden.
Das Makro sollte sich nicht an einem Zellenbereich aufhängen sondern nach der zuletzt verwendeten Zeile in Spalte A suchen (Hab so was ähnliches schon mal eingebaut, verstehe die Programmierung aber nicht die dahinter steckt).
Ich hoffe dass Ihr mein Problem versteht und das ganze mit VBA machbar ist.

Vorab schon mal vielen Dank für Eure Bemühungen. :-)

LG, N3O

PS: Wenn es nicht zuviel verlangt ist wäre es schon wenn Ihr mir den Code ein wenig aufschlüsselt. :-D

 

Re: Doppler finden, addieren, löschen ("Mit Sonderwünsc

Ich habe mal ein bißchen interpretiert und gefolgert, daß Du wahrscheinlich eher die Spalten C, D und E vergleichen möchtest und dann ggf. Spalte F aufaddiert haben möchtest. Sollte ich damit doch daneben liegen, ist es aber kein Problem, die Spalten in folgendem Source anzupassen:

Code:

Option Explicit

Private Sub CommandButton1_Click()

    Dim w1

    Dim y1 As Long
    Dim x1 As Long
    Dim tst1 As String
    Dim val1a As String
    Dim val1b As String
    Dim val1c As String

    Dim tst2 As String
    Dim val2a As String
    Dim val2b As String
    Dim val2c As String

    Set w1 = ActiveSheet

    'startkoordinaten der liste
    y1 = 1: x1 = 1
    w1.Activate: ActiveSheet.Cells(y1, x1).Activate
    'solange liste noch nicht zu ende
    tst1 = Trim$(w1.Cells(y1, x1).Value)
    While (tst1 <> "")

        'die 3 zu vergleichenden werte der aktuellen zeile
        val1a = Trim$(w1.Cells(y1, 3).Value)
        val1b = Trim$(w1.Cells(y1, 4).Value)
        val1c = Trim$(w1.Cells(y1, 5).Value)

        tst2 = Trim$(w1.Cells(y1 + 1, x1).Value)
        'die 3 zu vergleichenden werte der nächsten zeile
        val2a = Trim$(w1.Cells(y1 + 1, 3).Value)
        val2b = Trim$(w1.Cells(y1 + 1, 4).Value)
        val2c = Trim$(w1.Cells(y1 + 1, 5).Value)
        'solange liste noch nicht zu ende und werte übereinstimmen
        While (tst2 <> "") And (val2a = val1a) And (val2b = val1b) And (val2c = val1c)

            'werte addieren
            w1.Cells(y1, 6).Value = w1.Cells(y1, 6).Value + w1.Cells(y1 + 1, 6).Value
            'dublette löschen
            w1.Rows(y1 + 1).Delete
            
            'die nächsten vergleichswerte holen
            tst2 = Trim$(w1.Cells(y1 + 1, x1).Value)
            val2a = Trim$(w1.Cells(y1 + 1, 3).Value)
            val2b = Trim$(w1.Cells(y1 + 1, 4).Value)
            val2c = Trim$(w1.Cells(y1 + 1, 5).Value)
        Wend

        y1 = y1 + 1: x1 = 1
        w1.Activate: ActiveSheet.Cells(y1, x1).Activate
        tst1 = Trim$(w1.Cells(y1, x1).Value)
    Wend

End Sub

Wenn Du aber wirklich Spalte B vergleichen möchtest, wird's schwierig, sofern in der 2. Zeile dort wirklich eine leere Zelle steht...

Ich hab jetzt mal den Code oben mit geposted, falls Du direkt dazu Fragen haben solltest. du findest ihn aber auch im Anhang hinter dem Button versteckt. ;-)

Es läßt sich an dem Code sicher noch etwas optimieren, aber ich hab den mal bewußt etwas ausführlicher gelassen.

Aber die beiden (naja, 3 mit dim) Vorkommnisse von "tst2" sind wahrscheinlich etwas flüssiger als Wasser.

Und das Positionieren des Cursors während des Schleifendurchlaufs (Zeilen mit ".Activate") ist bei längeren Listen Geschmackssache. (Ich find's eher gut, aber es bremst die Abarbeitung gewaltig aus.)

Prinzipiell lassen sich natürlich auch die Zellen direkt vergleichen, statt die Werte vorher in Variablen zu holen. Wie gesagt: Eher der Übersichtlichkeit halber etwas ausführlicher...

Gruß, Michael

 

Hallo Michael,

Danke für deine schnelle Antwort! :-D
Mit den Spalten lagst du richtig. Hab Spalte A nachträglich eingefügt und vergessen das im Text zu ändern.

Muss das jetzt erst mal verdauen. Meld mich vieleicht morgen nochmal dazu.

LG, N3O

 

OK das klappt soweit schonmal super wenn die Werte untereinander stehen. Hab noch eine Sortierung eingebaut und den Code meiner Tabelle angepasst. (Das erspart mir sehr viel Arbeit bei mehreren Tausend Zeilen und Produkten. :-D )

In Stufe 2 möchte ich wenn Spalte C gleich, Spalte D gleich, Spalte E = A und Spalte F < 0,6 ist, Die Werte der Spalte F addieren und die Doppler löschen.

Wäre super wenn du mir denn Code anpassen könntest. :-D

Vorab schonmal danke für deine Bemühungen!

LG, N3O

 

Was ich vergessen haben zusätzlich soll der Eintrag in Spalte D bei den Verbleibenden Zeilen (Doppler die addiert wurden und alle bis auf den ersten gelöscht wurden/gemeint ist dieser eine) durch XY ersetzt werden.

Jetzt wirds wohl langsam kompliziert!?

Vorab Danke für eure Hilfe!

LG, N3O

 

Hallo zusammen,

Hab da mal ein bischen gebastelt.
Das dürfte dann wohl die Lösung sein?!

LG, N3O

 

Da hat sich wohl ein Fehler eingeschlichen.
Wenn es jemanden interessiert hier die Lösung.

LG, N3O