Anzeige
Archiv - Navigation
1548to1552
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

Doppelte werte löschen, ohne zu verschieben

Doppelte werte löschen, ohne zu verschieben
23.03.2017 19:24:00
Andy
Hallo zusammen,
ich versuche nun seit mehreren Stunden doppelte Werte in Spalte A zu zu finden, nur den ersten Wert stehen zu lassen und alle nachfolgenden Duplikate zu löschen, ohne dass die Zellen verschoben werden.
Bei der internen Funktion "Duplikate entfernen" werden zwar die Duplikate gefunden und entfernt, aber die dann verbleibenden Singelwerte stehen direkt untereinander.
Ich brauche aber eine Lösung, in der die verbleibenden Singelwerte genau da bleiben, wo sie auch vorher standen.
Habt Ihr einen Ansatz für mich?
Hier mal eine Musterdatei
https://www.herber.de/bbs/user/112380.xlsx
Vielen Dank schon mal und viele Grüße
Andy

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Doppelte werte löschen, ohne zu verschieben
23.03.2017 19:37:43
Daniel
Hi
da müsstest du dir mit einer Hilfsspalte behelfen.
Wenn die Werte sortiert bzw gruppiert sind, so das gleiche Werte direkt untereinander stehen, dann einfach so (für deine Beispieldatei)
in C4 diese Formel: =WENN(A4=A3;"";A4)
und bis zum Tabellenende runter ziehen.
Dann die Formel kopieren und in ab A4 als Wert einfügen.
Gruß Daniel
AW: Doppelte werte löschen, ohne zu verschieben
23.03.2017 19:40:51
KlausF
Hallo Andy,
probier mal:
Sub DuplikateLoeschen()
Dim strSuche As String
Dim i As Long
Dim x As Long
Application.ScreenUpdating = False
For i = Cells(Rows.Count, "A").End(xlUp).Row To 4 Step -1
If Application.WorksheetFunction.CountIf(Range("A4:A" & i), Cells(i, 1)) > 1 Then
strSuche = Cells(i, 1).Value
For x = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row To 4 Step -1
If Cells(x, 1).Value = strSuche Then
If Application.WorksheetFunction.CountIf(Range("A4:A" & x), Cells(x, 1)) > 1  _
Then
Cells(x, 1).ClearContents
End If
End If
Next x
End If
Next
End Sub
In Deinem Beispiel bleibt in Zeile 24 die Ziffer 25 stehen, das wäre allerdings nicht korrekt.
Gruß
Klaus
Anzeige
AW: Doppelte werte löschen, ohne zu verschieben
23.03.2017 20:05:02
ChrisL
Hi Andy
Die Gretchenfrage ist ob Zeile 24 ein Fehler ist oder nicht. Mir wäre die Zeile übrigens nicht aufgefallen und ich hätte auf die gleiche Antwort wie Daniel tendiert.
Falls Zeile 24 korrekt = Daniel
=WENN(A4=A3;"";A4)
Falls Zeile 24 inkorrekt = Klaus
=WENN(ZÄHLENWENN(A$4:A4;A4)>1;"";A4)
In VBA würde ich zur Vermeidung der Schleife folgende Lösung anwenden:
With Range("C4:C" Cells(Rows.Count, 1).End(xlUp).Row)
.FormulaLocal = "=WENN(A4=A3;"""";A4))"
.OffSet(0, -2).Value = .Value
.ClearContents
End With
cu
Chris
Anzeige
AW: Doppelte werte löschen, ohne zu verschieben
23.03.2017 20:07:01
Andy
Achso,
ja, Zeile 24 war menschliches Versagen!
Das kann zum Glück mit Euren Lösungen nicht passieren!
Danke!
AW: Doppelte werte löschen, ohne zu verschieben
23.03.2017 20:05:34
Andy
Hallo Daniel und KlausF,
vielen vielen Dank!
Da das Löschen teil eines Programmes werden soll, verwende ich die Lösung von Klaus.
Funktioniert super!
Danke und habt einen schönen Abend!
AW: Doppelte werte löschen, ohne zu verschieben
23.03.2017 20:19:57
GraFri
Hallo Andy
Noch eine Möglichkeit:
Option Explicit
Sub Doppelte_löschen()
Dim myDic As Object
Dim Zeile As Long
Set myDic = CreateObject("Scripting.Dictionary")
For Zeile = 4 To 39
If myDic.Exists(Cells(Zeile, 1).Value) Then
Cells(Zeile, 1).Value = ""
Else
myDic.Add Cells(Zeile, 1).Value, ""
End If
Next Zeile
Set myDic = Nothing
End Sub
mfg, GraFri
Anzeige

77 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige