Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1272to1276
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makroänderung

Makroänderung
Karin
Hallo ihr Experten,
folgendes Makro löscht die doppelten Einträge in Spalte A und nur 1 Eintrag der doppelten bleibt stehen.
Sub DoppelteLöschen()
Dim x As Long
For x = Range("A65536").End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("A1:A" & x), Cells(x, 1)) > 1 Then
Cells(x, 1).EntireRow.Delete
End If
Next
End Sub
Wer kann mir das Makro so ändern, dass alle doppelten Einträge in Spalte A gelöscht werden, d.h. alle Einträge die doppelt vorhanden sind werden gelöscht,- die einzelnen Einträge müssen aber stehen bleiben.
Vielen Dank im voraus.
Gruß
Karin

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makroänderung
02.08.2012 14:28:55
Rudi
Hallo,
dann muss man sich die vorher merken.
Sub xxxxx()
Dim rngC As Range, rngDel As Range
For Each rngC In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
If Application.CountIf(rngC, Columns(1)) > 1 Then
If rngDel Is Nothing Then
Set rngDel = rngC
Else
Set rngDel = Union(rngDel, rngC)
End If
End If
Next
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End Sub

Gruß
Rudi
AW: Makroänderung
02.08.2012 16:10:38
Karin
Hallo Rudi,
vielen Dank für deine Antwort.
Leider klappt es nicht bei mir, das Markro zeigt keinerlei Wirkung. Ich weiss nicht warum das bei mir nicht klappt.
Als Anlage habe ich noch mal ein Beispiel beigefügt.
Kann mich morgen erst wieder melden.
Vielen Dank im Voraus.
Liebe Grüße
Karin
Userbild
Anzeige
Korrektur
02.08.2012 16:34:30
Rudi
Hallo,
hatte nen Fehler drin.
Sub xxxxx()
Dim rngC As Range, rngDel As Range
For Each rngC In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
If Application.CountIf(Columns(1), rngC) > 1 Then
If rngDel Is Nothing Then
Set rngDel = rngC
Else
Set rngDel = Union(rngDel, rngC)
End If
End If
Next
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End Sub

Gruß
Rudi
AW: Korrektur
03.08.2012 08:00:27
Karin
Hallo Rudi,
vielen Dank für deine Lösung. Es funktioniert super. Danke.
Ich wünsche dir ein schönes (sonniges) Wochenende.
Liebe Grüße
Karin
Anzeige
AW: Makroänderung
02.08.2012 14:29:07
Rudi
Hallo,
dann muss man sich die vorher merken.
Sub xxxxx()
Dim rngC As Range, rngDel As Range
For Each rngC In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
If Application.CountIf(rngC, Columns(1)) > 1 Then
If rngDel Is Nothing Then
Set rngDel = rngC
Else
Set rngDel = Union(rngDel, rngC)
End If
End If
Next
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige