PDA

Vollständige Version anzeigen : In Zelle doppelten Inhalt Löschen


Paul26_01
10.04.2012, 11:55
Hallo ihr Lieben,
Ich möchte gerne in allen Spalten jede Zelle nach unten gehen und in jeder Zelle die doppelten Einträge löschen.

Meine Zellen sehen beispielsweise wie folgt aus:

A2:

Peter
Hans
Wolf
Peter
Christopher
Dudu
Gerhardt
Wolf

usw. (immer hinter den Namen ALT+Enter)

Dankeschön im vorraus

gruß

Rudi Maintaire
10.04.2012, 12:13
Hallo,
in ein Modul:
Sub aaaaa()
Dim rngC As Range, oDict As Object, arrTmp, strTmp
Application.ScreenUpdating = False
Set oDict = CreateObject("Scripting.dictionary")
For Each rngC In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
oDict.RemoveAll
arrTmp = Split(rngC, vbLf)
For Each strTmp In arrTmp
oDict(strTmp) = 0
Next
rngC = Join(oDict.keys, vbLf)
Next
Set oDict = Nothing
End Sub
Gruß
Rudi

Paul26_01
10.04.2012, 13:38
Hallo,

danke für die schnelle Antwort, funktioniert derzeit nur in einer Spalte,

bekomme ich es hin das ganze ab Spalte B solang bis keine Spalten mehr Inhalt haben???

Gruß
Dankeschön

Hasso
10.04.2012, 14:23
Hallo Paul,

dann müsstest du in
For Each rngC In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))


die 1 durch die letzte Spalte ersetzen, also z.B.
For Each rngC In Range(Cells(2, ActiveSheet.UsedRange.Columns.Count), Cells(Rows.Count, ActiveSheet.UsedRange.Columns.Count).End(xlUp))

wenn die Spalten sich im aktiven Blatt befinden

EarlFred
10.04.2012, 15:34
Hallo Dankeschön,

For Each rngC In Intersect(ActiveSheet.UsedRange, Range(Columns(2), Columns(Columns.Count)))

Grüße
EarlFred

Paul26_01
11.04.2012, 06:19
Guten Morgen,

das ganze funktioniert echt super und brauch auch nicht viel Zeit

Dankeschön :top: