Supportnet / Forum / Tabellenkalkulation
doppelte löschen (VBA)
Frage
Hallo zusammen
Viele Einträge zu diesem Thema sind schon da. Jedoch nicht das was ich suche.
Habe eine Liste mit gleichen Debitor - Nr. in Spalte A. All diese die doppelt vorhanden sind, sollen aus der Liste. Also nicht mehr einfach in der Liste sonder gar nicht mehr. Wäre froh um eine schnelle Antwort.
Danke
Grüsse Maxli
Antwort 1 von Saarbauer
Hallo,
da das Problem im folgend genannten Thread schon einmal behandelt wurde, der Link zum Thread
https://supportnet.de/threads/1086612
Gruß
Helmut
da das Problem im folgend genannten Thread schon einmal behandelt wurde, der Link zum Thread
https://supportnet.de/threads/1086612
Gruß
Helmut
Antwort 2 von maxli
Hallo
Danke für die schnelle Antwort. Zum besseren Verständnis ein Beispiel:
Spalte A
1092
1092
1122
usw.
Jetzt wenn ein Debitor doppelt erscheint (1092), so soll er nach dem Ausführen vom Makro nicht mehr vorhanden sein.
Spalte A
1122
Danke und Grüsse
Maxli
Danke für die schnelle Antwort. Zum besseren Verständnis ein Beispiel:
Spalte A
1092
1092
1122
usw.
Jetzt wenn ein Debitor doppelt erscheint (1092), so soll er nach dem Ausführen vom Makro nicht mehr vorhanden sein.
Spalte A
1122
Danke und Grüsse
Maxli
Antwort 3 von maxli
Hallo zusammen
Wäre wirklich froh um eine Lösung.
Bitte meldet euch.
Gruss Maxli
Wäre wirklich froh um eine Lösung.
Bitte meldet euch.
Gruss Maxli
Antwort 4 von Saarbauer
Hallo Jörg,
im Prinzip ist es mit zwei verschachtelten Schleifen zu machen.
Dabei beginnt die Erste in Zeile 1 und die Zweite beginnt immer in ( Erste + 1).
Die Zweite durchläuft alle Zeilen bis zum Schluß, erst dann rückt die Erste eine Zeile weiter.
Werden gleiche Nummern gefunden werden Erste Zeile i und Zweite Zeile y gelöscht.
Da alle zeilen eins nach oben rutschen ist der Index der zweiten Schleife auf den Index der Ersten + 1 zu setzen und damit überprüft die zweite Schleife alle folgenden Werte.
Gruß
Helmut
P.S. Solltest du bis Wochendene keine Lösung haben versuch ich dir mal die Lösung zuzammenzubauen.
im Prinzip ist es mit zwei verschachtelten Schleifen zu machen.
Dabei beginnt die Erste in Zeile 1 und die Zweite beginnt immer in ( Erste + 1).
Die Zweite durchläuft alle Zeilen bis zum Schluß, erst dann rückt die Erste eine Zeile weiter.
Werden gleiche Nummern gefunden werden Erste Zeile i und Zweite Zeile y gelöscht.
Da alle zeilen eins nach oben rutschen ist der Index der zweiten Schleife auf den Index der Ersten + 1 zu setzen und damit überprüft die zweite Schleife alle folgenden Werte.
Gruß
Helmut
P.S. Solltest du bis Wochendene keine Lösung haben versuch ich dir mal die Lösung zuzammenzubauen.
Antwort 5 von Saarbauer
Hallo,
es ging doch schneller.
Dieses Makro einsetzen
Sub Doppelte_Finden()
´ Doppelte_Finden Makro
´ Makro am 04.07.2005 von Saarbauer
Dim Debitor As String, Index As String
´Sheets("Bezeichnung Arbeitsblatt").Select
´Es wird vorausgesetzt, dass in Zeile 1 die Spaltennamen stehen und dass die zu überprüfenden Werte in Spalte A stehen.
Range("a2").Select
While IsEmpty(ActiveCell) = False
Debitor = ActiveCell.Value
i = ActiveCell.Row()
ActiveCell.Offset(1, 0).Select
While IsEmpty(ActiveCell) = False
If ActiveCell.Value = Debitor Then
y = ActiveCell.Row()
Rows(ActiveCell.Row()).Select
Selection.Delete
Rows(i).Select
Rows(ActiveCell.Row()).Select
Selection.Delete
End If
ActiveCell.Offset(1, 0).Select
Wend
Rows(i).Select
ActiveCell.Offset(1, 0).Select
Wend
End Sub
Aber datei vor erstem Test sichen und Anmekrung im Makro zu Spaltennamen und Vergleichswerten beachten.
Gruß
Helmut
es ging doch schneller.
Dieses Makro einsetzen
Sub Doppelte_Finden()
´ Doppelte_Finden Makro
´ Makro am 04.07.2005 von Saarbauer
Dim Debitor As String, Index As String
´Sheets("Bezeichnung Arbeitsblatt").Select
´Es wird vorausgesetzt, dass in Zeile 1 die Spaltennamen stehen und dass die zu überprüfenden Werte in Spalte A stehen.
Range("a2").Select
While IsEmpty(ActiveCell) = False
Debitor = ActiveCell.Value
i = ActiveCell.Row()
ActiveCell.Offset(1, 0).Select
While IsEmpty(ActiveCell) = False
If ActiveCell.Value = Debitor Then
y = ActiveCell.Row()
Rows(ActiveCell.Row()).Select
Selection.Delete
Rows(i).Select
Rows(ActiveCell.Row()).Select
Selection.Delete
End If
ActiveCell.Offset(1, 0).Select
Wend
Rows(i).Select
ActiveCell.Offset(1, 0).Select
Wend
End Sub
Aber datei vor erstem Test sichen und Anmekrung im Makro zu Spaltennamen und Vergleichswerten beachten.
Gruß
Helmut
Antwort 6 von maxli
Hallo Helmut
Irgendetwas mache ich noch falsch es kommt: Fehler beim kompilieren - Syntaxfehler
Gruss
Maxli
Irgendetwas mache ich noch falsch es kommt: Fehler beim kompilieren - Syntaxfehler
Gruss
Maxli
Antwort 7 von Saarbauer
Hallo,
hab mal getestet, bei mir kommen folgende Zeilen in rot:
´ Doppelte_Finden Makro
´ Makro am 04.07.2005 von Saarbauer
´Sheets("Bezeichnung Arbeitsblatt").Select
´Es wird vorausgesetzt, dass in Zeile 1 die
Spaltennamen stehen und dass die zu überprüfenden
Dort werden die Hochkommas anscheinend nicht richtig übertragen, erstetze die Hochkommas durch das Hochkomma über # ,dann sollte der Text grün werden
Gruß
Helmut
hab mal getestet, bei mir kommen folgende Zeilen in rot:
´ Doppelte_Finden Makro
´ Makro am 04.07.2005 von Saarbauer
´Sheets("Bezeichnung Arbeitsblatt").Select
´Es wird vorausgesetzt, dass in Zeile 1 die
Spaltennamen stehen und dass die zu überprüfenden
Dort werden die Hochkommas anscheinend nicht richtig übertragen, erstetze die Hochkommas durch das Hochkomma über # ,dann sollte der Text grün werden
Gruß
Helmut
Antwort 8 von maxli
Hallo Helmut
Funktioniert prima. Danke
Nur die Geschwindigkeit bei 7500 Datensätzen ist ein wenig gering, aber es geht.
Vielen Dank
Grüsse Maxli
Funktioniert prima. Danke
Nur die Geschwindigkeit bei 7500 Datensätzen ist ein wenig gering, aber es geht.
Vielen Dank
Grüsse Maxli
Antwort 9 von Saarbauer
Hallo,
das ist das Problem von Schleifen. Da im Prinzip jeder Datensatz mit jeden geprüft wird.
Hängt auch etwas vom PC ab.
Freut mich, dass das Makro deinen Vorstellungen entspricht.
Gruß
Helmut
das ist das Problem von Schleifen. Da im Prinzip jeder Datensatz mit jeden geprüft wird.
Hängt auch etwas vom PC ab.
Freut mich, dass das Makro deinen Vorstellungen entspricht.
Gruß
Helmut
Antwort 10 von guethi
Hallo!
Bei mir läuft das Makro nicht...kann bitte mal jemand einen Blick darauf werfen, was ich hier verhackstückt habe?
Das Makro soll alle Werte aus Spalte A Tabelle unter den letzten Wert in SpalteA Tabelle kopieren und anschließend die Dubletten löschen.
Schon vorab vielen Dank für eure Bemühungen.
Viele Grüße,
guethi
Bei mir läuft das Makro nicht...kann bitte mal jemand einen Blick darauf werfen, was ich hier verhackstückt habe?
Das Makro soll alle Werte aus Spalte A Tabelle unter den letzten Wert in SpalteA Tabelle kopieren und anschließend die Dubletten löschen.
Zitat:
Sub kopieren_und_löschen()
´Kopiert die Spalte A aus Blatt 1 unter die Liste in Spalte B - dieser Teil klappt´
Sheets("Tabelle1").Select
Range("A1:A5000").Select
Selection.copy
Sheets("Tabelle2").Select
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
´Entfernt alle Dubletten, danach stehen in dieser Spalte nur die Fehlwerte´
´ UND DAS KLAPPT NICHT: ´
Dim Name As String, Index As String
Sheets("Tabelle2").Select
Range("a1").Select
While IsEmpty(ActiveCell) = False
Name = ActiveCell.Value
i = ActiveCell.Row()
ActiveCell.Offset(1, 0).Select
While IsEmpty(ActiveCell) = False
If ActiveCell.Value = Name Then
y = ActiveCell.Row()
Rows(ActiveCell.Row()).Select
Selection.Delete
Rows(i).Select
Rows(ActiveCell.Row()).Select
Selection.Delete
End If
ActiveCell.Offset(1, 0).Select
Wend
Rows(i).Select
ActiveCell.Offset(1, 0).Select
Wend
End Sub
Sub kopieren_und_löschen()
´Kopiert die Spalte A aus Blatt 1 unter die Liste in Spalte B - dieser Teil klappt´
Sheets("Tabelle1").Select
Range("A1:A5000").Select
Selection.copy
Sheets("Tabelle2").Select
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
´Entfernt alle Dubletten, danach stehen in dieser Spalte nur die Fehlwerte´
´ UND DAS KLAPPT NICHT: ´
Dim Name As String, Index As String
Sheets("Tabelle2").Select
Range("a1").Select
While IsEmpty(ActiveCell) = False
Name = ActiveCell.Value
i = ActiveCell.Row()
ActiveCell.Offset(1, 0).Select
While IsEmpty(ActiveCell) = False
If ActiveCell.Value = Name Then
y = ActiveCell.Row()
Rows(ActiveCell.Row()).Select
Selection.Delete
Rows(i).Select
Rows(ActiveCell.Row()).Select
Selection.Delete
End If
ActiveCell.Offset(1, 0).Select
Wend
Rows(i).Select
ActiveCell.Offset(1, 0).Select
Wend
End Sub
Schon vorab vielen Dank für eure Bemühungen.
Viele Grüße,
guethi
Antwort 11 von guethi
Ich muss grad noch einen Dummy-Einrag dranhängen, wegen der Benachrichtigung.:-/ Sorry, vielleicht kann das ein netter Admin korrigieren und die Benachrichtigung bei meinem ersten Eintrag aktivieren. Thx