Excel Makro Zellen überprüfen,verschieben, löschen

[Surranian]

Hallo liebe Community,

ich wende mich an euch, in der Hoffnung jemanden zu finden, der mir bei meinem Problem helfen kann. Ich brauche ein Makro und habe leider nicht genug Ahnung davon, um mir selber helfen zu können.

Folgendes Problem stellt sich mir:
Ich habe eine Excel Tabelle, diese setzt sich aus exportierten Daten zusammen. In dieser Tabelle habe ich beliebig viele Kunden (bedeutet auch beliebig viele Zeilen) mit Bestelldaten. Ich möchte nun erreichen, dass das Makro überprüft, ob der Text in Zelle B2 mit dem Text in B1 übereinstimmt. Wenn ja, dann soll Zelle C2 kopiert und in Zelle D1 eingefügt werden und die komplette Zeile gelöscht werden. Dann wieder von vorne, allerdings müsste dann bei Übereinstimmung C2 in E2 kopiert werden und immer so weiter (wobei das maximal 10x vorkommt, im schlimmsten Fall). Wenn keine Übereinstimmung vorliegt, die nächste Zeile prüfen.

Wie gesagt die Liste kann beliebig lang sein. Da ich diese Tabellen für meine Arbeit benötige und diese Aufbereitung auch öfters machen muss (unter anderem auch Kollegen), dachte ich an ein Makro. Ich hoffe, dass ich mein Anliegen einigermaßen anschaulich erklären konnte und dass sich das auch tatsächlich realisieren lässt.

Ich bedanke mich schon mal im Voraus recht herzlich für Eure Hilfe!

Liebe Grüße

[R_Kelly]

Hallo Surranian,

sub test()
dim z as integer

for z = 2 to activesheet.Cells(Rows.Count, 1).End(xlUp).Row
if activesheet.cells(z,2).value = activesheet.cells(1,2).value then
activesheet.cells(z,3).copy activesheet.cells(z-1,4)
activesheet.rows(z).clear
end if
next z

For z = activesheet.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If activesheet.Cells(z, 2).Value = „“ and activesheet.cells(z,4) = „“ Then
activesheet.Rows(z).Delete
End If
Next z

end sub

Das Makro überprüft nacheinander alle tatsächlich gefüllten Zeilen laut Deiner Frage, wobei denn Sinn nicht so ganz verstanden habe. Denn Du willst teilweise Zeilen löschen, die vorher gelöscht werden sollten.
Ich habe das jetzt wie folgt umgesetzt:
Teste nacheinander alle Zeilen bis zur Letzten durch. Wenn der Inhalt der aktuellen Zeile Spalte B mit Zelle B1 übereinstimmt, dann kopiere die aktuelle Zeile Spalte C in die Zeile drüber Spalte D und säubere die aktuelle Zeile. Wenn die komplette Überprüfung abgeschlossen ist schau nach leeren Zeilen und lösche diese.

Ich habe den Code aber nicht getestet mangels Beispiel-Zahlen.

Gruß
Ronny

[Surranian]

Hallo Ronny,

danke schonmal für dieses Makro, ganz so wie ich mir das vorgestellt habe scheint es aber nicht zu funktionieren, was sicher an meiner mangelnden Erklärung liegt. Ich versuchs einfach nochmal

Also hier mal eine Beispieltabelle:

A B C D E F G H I …
1 Name Straße PLZ Ort KDNR Bestellung
2 Max Musterstr 02929 Muster 4711 10 Jacken
3 Max Musterstr 02929 Muster 4711 10 Blusen
4 Max Musterstr 02929 Muster 4711 10 Hosen
5 Bayer Bayerstr 45154 See 4985 20 Mäntel
6 Bayer Bayerstr 45154 See 4985 15 T-Shirts
7 Heinrich Allee 58578 Baum 5874 17 Paar Strümpfe

1. Soll das Makro prüfen, ob KDNR aus E3 mit E2 übereinstimmt, wenn ja kopiere F3 in G2 und lösche dann komplette Zeile 3 (wird dann nicht mehr benötigt).

2. Mache das selbe mit nächster Zeile, prüfe wieder ob Zelle Kundennummer mit darüber liegender Kundenummer übereinstimmt. Wenn ja muss erneut Zelle Bestellung kopiert werden und diesmal aber in H eingefügt werden. Dann die Zeile wieder löschen.

3. Wieder von vorne anfangen, wenn mal keine Übereinstimmung vorliegt, dann soll nichts passieren und direkt mit der nächsten Zeile analog weitergemacht werden.

Ergebnis unserer Beispieltabelle sollte dann so aussehen:

A B C D E F G H I …
1 Name Straße PLZ Ort KDNR Bestellung
2 Max Musterstr 02929 Muster 4711 10 Jacken 10 Blusen 10 Ho
3 Bayer Bayerstr 45154 See 4985 20 Mäntel 15 Tshirts
4 Heinrich Allee 58578 Baum 5874 17 Paar Strümpfe

Eventuell ist es so anschaulicher!

Nochmals danke für die Hilfe und weitere Tipps, Anregungen, Makros

Liebe Grüße

[R_Kelly]

Kein Problem

Sub sortierung()
Dim z As Integer
Dim y As Integer
Dim Kd As String

For z = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Kd = ActiveSheet.Cells(z, 4).Value
For y = z + 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If Kd = ActiveSheet.Cells(y, 4) Then
ActiveSheet.Cells(y, 5).Copy ActiveSheet.Cells(z, ActiveSheet.Cells(z, Columns.Count).End(xlToLeft).Column + 1)
ActiveSheet.Rows(y).Clear
End If
Next y
Next z

For z = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If ActiveSheet.Cells(z, 1).Value = „“ Then
ActiveSheet.Rows(z).Delete
End If
Next z

End Sub

Der Code setzt Dein Beispiel 1:1 um, also gegebenenfalls musst Du die „Cells(Zeile, Spalte)“ noch anpassen.
Das Makro sucht jetzt übrigens in allen Zeilen nach Übereinstimmungen, d.h. auch wenn die Kunden vertreut und nicht nacheinander auftauchen bastelt er Dir Deine Tabelle zusammen.

Gruß Ronny

[Surranian]

Kein Problem find ich immer gut!
Es ist einfach perfekt, tausend Dank

[kackei]

Hallo.

Basierend darauf, dass der erste Name in Zelle A2 steht, versuch mal folgendes:

Private Sub Liste()

i = 3
a = i - 1
Do Until Range(„E“ & i) = „“
Range(„E“ & i).Select
kdnr_alt = Range(„E“ & a)
kdnr_neu = Range(„E“ & i)
If kdnr_neu = kdnr_alt Then
Rows("" & i & „:“ & i & „“).Select
Selection.Delete Shift:=xlUp
Else
i = i + 1
a = i - 1
End If
Loop

Range(„A1“).Select

End Sub

Vorgehensweise des Makros:
aus Zelle Ea (im ersten Schritt E2) wird der Wert ausgelesen (kdnr_neu). Anschließend wird aus Zelle Ei (im ersten Schritt E3) der Wert ausgelesen (kdnr_neu). anschließend wird verglichen, ob beide Werte identisch sind. Ist dies der Fall, dann wird die Zeile i (im ersten Schritt Zeile 39 komplett gelöscht. anschließen wird die Schleife wieder begonnen, wobei die kdnr_neu wieder in Zelle E3 ausgelesen wird. Sind kdnr_alt und kdnr_neu nicht gleich werden i und a um eins erhöht bzw a=i-1 nachdem i um eins erhöht wurde. Dann beginnt die zweite Schleife. Ende der Schleife ist, wenn die Zelle Ei leer ist. In diese Fall wird Zelle A1 angewählt und das Makro beendet.

Sollte funktionieren, habe es mit 4 Zeilen ausprobiert.

Grüße, Aiko.

[kackei]

Hallo nochmal.

Da fehlte in meinem letzten Code noch etwas, nämlich das eintragen der Artikel. Dies habe ich jetzt eingefügt (Extraschleife).

Private Sub Liste()

i = 3
a = i - 1
Do Until Range(„E“ & i) = „“
Range(„E“ & i).Select
kdnr_alt = Range(„E“ & a)
kdnr_neu = Range(„E“ & i)
If kdnr_neu = kdnr_alt Then
artikel = Range(„F“ & i)
Range(„G“ & a).Select
zellensuchen:
If ActiveCell = „“ Then
ActiveCell = artikel
Else
ActiveCell.Offset(0, 1).Select
If 1 = 1 Then GoTo zellensuchen
End If
Rows("" & i & „:“ & i & „“).Select
Selection.Delete Shift:=xlUp
Else
i = i + 1
a = i - 1
End If
Loop

End Sub

Das müsste es doch jetzt sein, oder?

Grüße, Aiko.

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

[Surranian]

Hallo Aiko,

danke das du dir auch nochmal die Mühe gemacht hast.
Ronny hatte mir bereits ein funktionierendes Makro an die Hand gegeben, deins funktioniert aber auch

Liebe Grüße