Doppler finden, addieren, löschen ("Mit Sonderwünschen& :: Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office

Einloggen, um private Nachrichten zu lesen

Downloads

[Excel 2003] Doppler finden, addieren, löschen ("Mit Sonderwünschen&

Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office Foren-Übersicht » Microsoft Excel Hilfe

Autor

Nachricht

N3O
Newbie
Newbie

Anmeldedatum: 20.05.2008
Beiträge: 19

Verfasst am: 20.05.2008, 14:20

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. Smile

LG, N3O

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

miriki
Schlauberger

Anmeldedatum: 05.03.2007
Beiträge: 435
Wohnort: Kiel

Verfasst am: 20.05.2008, 15:07

N3O hat Folgendes geschrieben:

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 [...] gelöscht werden.

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. Wink

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

dubletten.xls

Beschreibung:

Download

Dateiname:

dubletten.xls

Dateigröße:

28.5 KB

Heruntergeladen:

24 mal

N3O
Newbie
Newbie

Anmeldedatum: 20.05.2008
Beiträge: 19

Verfasst am: 20.05.2008, 15:29

Hallo Michael,

Danke für deine schnelle Antwort! Very Happy

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

N3O
Newbie
Newbie

Anmeldedatum: 20.05.2008
Beiträge: 19

Verfasst am: 21.05.2008, 10:25

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. Very Happy

)

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. Very Happy

Vorab schonmal danke für deine Bemühungen!

LG, N3O

N3O
Newbie
Newbie

Anmeldedatum: 20.05.2008
Beiträge: 19

Verfasst am: 21.05.2008, 12:13

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

N3O
Newbie
Newbie

Anmeldedatum: 20.05.2008
Beiträge: 19

Verfasst am: 21.05.2008, 14:09

Hallo zusammen,

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

LG, N3O Cool

dubletten.xls

Beschreibung:

Download

Dateiname:

dubletten.xls

Dateigröße:

28 KB

Heruntergeladen:

20 mal

N3O
Newbie
Newbie

Anmeldedatum: 20.05.2008
Beiträge: 19

Verfasst am: 21.05.2008, 14:33

Da hat sich wohl ein Fehler eingeschlichen. Embarassed

Wenn es jemanden interessiert hier die Lösung.

LG, N3O

dubletten.xls

Beschreibung:

Download

Dateiname:

dubletten.xls

Dateigröße:

28 KB

Heruntergeladen:

21 mal

Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office Foren-Übersicht » Microsoft Excel Hilfe

Thema		Autor	Forum	Antworten	Verfasst am
Ähnliche Beiträge
	Button "Dateispeicherort" a...	tobias.s	Microsoft Word Hilfe	0	19.11.2008, 15:44
	[Access 2000]Datenbankeinträge löschen	Franzose	Microsoft Access Hilfe	2	14.11.2008, 09:13
	"In eine Zahl umwandeln" pe...	Frederic	Microsoft Excel Hilfe	4	13.11.2008, 15:46
	"Live-search"	iBenu	Microsoft Access Hilfe	0	13.11.2008, 12:50
	Nur bestimmte Werte einer Spalte addi...	Juvenis	Microsoft Excel Hilfe	3	12.11.2008, 08:08

Gehe zu:

Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum posten
Du kannst Dateien in diesem Forum herunterladen

Powered by phpBB © 2001, 2002 phpBB Group :: FI Theme :: Alle Zeiten sind GMT + 1 Stunde
Deutsche Übersetzung von phpBB.de