Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.10.2025 11:48:44
Makro von Excel in Word aufrufen
16.10.2025 11:16:26
SUMMEWENN erweitern
16.10.2025 09:40:53
Mehrere Konferenzen ohne Personenüberschneidung terminieren
16.10.2025 00:15:51
Passwort im Herbersforum ändern
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
932to936
932to936
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Schleife zum löschen von Dupletten

Forumthread: Schleife zum löschen von Dupletten

Schleife zum löschen von Dupletten
14.12.2007 14:38:00
Dupletten
Hallöchen,
irgendwie habe ich heute glaube ich einen Knoten im Gehirn. Folgende Problematik: Ich habe in einer Zeile hintereinander in den Zellen Folgendes stehen. Also je Zelle ein Buchstabe (oder auch ein ganzes Wort)
A A B B B B C C D D D D D E E F F F F G G H I I J J J J
rauskommen soll
A B C D E F G H I J
Also nur der jeweils erste Wert soll stehen bleiben und die anderen Zellen sollen gelöscht werden. Nicht aufrücken, einfach nur leer werden. Geht das wirklich nur über 2 verschachtelte Schleifen oder gibt es noch einen eleganteren/kürzeren Trick? Also lasse ich eine Rahmenschleife laufen und wenn Ax=Bx ist, dann läuft die innere Schleife los, so lange bis ein neuer Wert kommt. Aber ist das nicht umständlich?
Wird Zeit das es Feierabend wird ;)
LG,
Tommi

Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: Schleife zum löschen von Dupletten
14.12.2007 15:14:00
Dupletten
Hallo Bjoern,
ähm, ich habe da 16 Zeile Code stehen, der erledigt alles wunderbar, ich suchte eigentlich nach einer einfacheren/eleganteren/kürzeren Variante ;) Das erscheint mir doch etwas oversized...
Aber ich schaue mir das mal gelegentlich an.
LG,
Tommi

Anzeige
AW: Schleife zum löschen von Dupletten
14.12.2007 17:38:43
Dupletten
Hallo Tommi,
das beigefügte Makro nimmr die Werte aus Zeile 1 und gibt sie ohne dopplete in Zeile 2 aus.

Public Sub Ohne_Doppelte()
Dim iSpalte_Q  As Integer
Dim iSpalte_Z  As Integer
Dim Eingabe    As New Collection
On Error Resume Next ' das On Error ist wichtig für die Collection !!!
For iSpalte_Q = 1 To Cells(1, 256).End(xlToLeft).Column
'   ACHTUNG: Collection verlangen Text                             |
'                                                                  V
Eingabe.Add Item:=Cells(1, iSpalte_Q), Key:=Cells(1, iSpalte_Q).Text
If Err = 0 Then
iSpalte_Z = iSpalte_Z + 1
Cells(2, iSpalte_Z).Value = Cells(1, iSpalte_Q).Value
Else
Err.Clear
End If
Next iSpalte_Q
End Sub


Gruß Peter

Anzeige
AW: Schleife zum löschen von Dupletten
14.12.2007 17:38:43
Dupletten
Hallo Tommi,
das beigefügte Makro nimmr die Werte aus Zeile 1 und gibt sie ohne dopplete in Zeile 2 aus.

Public Sub Ohne_Doppelte()
Dim iSpalte_Q  As Integer
Dim iSpalte_Z  As Integer
Dim Eingabe    As New Collection
On Error Resume Next ' das On Error ist wichtig für die Collection !!!
For iSpalte_Q = 1 To Cells(1, 256).End(xlToLeft).Column
'   ACHTUNG: Collection verlangen Text                             |
'                                                                  V
Eingabe.Add Item:=Cells(1, iSpalte_Q), Key:=Cells(1, iSpalte_Q).Text
If Err = 0 Then
iSpalte_Z = iSpalte_Z + 1
Cells(2, iSpalte_Z).Value = Cells(1, iSpalte_Q).Value
Else
Err.Clear
End If
Next iSpalte_Q
End Sub


Gruß Peter

Anzeige
AW: Schleife zum löschen von Dupletten
14.12.2007 20:56:00
Dupletten
Hallo Tommy,
falls die Find-Methode in deiner xl-Version funktioniert.

Sub a()
Dim lngZeile As Long, intErsteSpalte As Integer, intLetzteSpalte As Integer, x As Integer
Dim rng As Range
lngZeile = 1
intErsteSpalte = 1
intLetzteSpalte = Cells(lngZeile, 256).End(xlToLeft).Column
For x = intLetzteSpalte To intErsteSpalte + 1 Step -1
Set rng = Range(Cells(lngZeile, intErsteSpalte), Cells(lngZeile, x - 1)). _
Find(Cells(lngZeile, x).Text, lookat:=xlWhole, LookIn:=xlValues)
If Not rng Is Nothing Then Cells(lngZeile, x).ClearContents
Next
End Sub


Gruß Gerd

Anzeige
AW: Schleife zum löschen von Dubletten
14.12.2007 21:41:19
Dubletten
Hallo Thomas,
wenn es so sein soll, wie du es dargestellt hast unter "rauskommen soll", dann für beliebig viel Zeilen ab Zeile 1
'
' nun erfolgt der Übertrag (aus eimem temporären Array) in die gleiche Zeile
'

Public Sub Ohne_Doppelte_I()
Dim lZeile      As Long           ' der For/Next Schleifen-Index der Zeilen
Dim iSpalte     As Integer        ' der For/Next Schleifen-Index der abzusuchenden Spalten
Dim Eingabe     As New Collection ' die Collection - die Sammlung ohne dopplete
Dim aAusgabe()  As Variant        ' der Array zur Aufnahme der Daten ohne doppelte
Dim iIndex      As Integer        ' der Index zum Array
Application.ScreenUpdating = False ' den Bildschirm-Update unterbinden
On Error Resume Next ' das On Error ist wichtig für die Collection !!!
For lZeile = 1 To Cells(Rows.Count, 1).End(xlUp).Row     ' ab Zeile 1 bis zur letzten  _
belegten
Set Eingabe = Nothing                                 ' die Collection löschen
Erase aAusgabe                                        ' den Array löschen
iIndex = 0                                            ' den Index zurücksetzen
For iSpalte = 1 To Cells(lZeile, 256).End(xlToLeft).Column ' die Spalten abarbeiten
Eingabe.Add Item:=Cells(lZeile, iSpalte), Key:=Cells(lZeile, iSpalte).Text
If Err = 0 Then                                    ' gab es einen doppelten Eintrag ?
iIndex = iIndex + 1                             ' den Index hochrechnen
ReDim Preserve aAusgabe(iIndex)                 ' den Array redimensionieren
aAusgabe(iIndex) = Cells(lZeile, iSpalte).Value ' den Wert EINMAL in den Array
Else                                              ' sonst
Err.Clear                                       ' den Fehler (weil dopplet) löschen
End If
Next iSpalte                                          ' die nächste Spalte
'       nun wird die auf doppelte untersuchte Zeile gelöscht und der Array übertragen
Range(Cells(lZeile, 1), Cells(lZeile, Cells(lZeile, 256).End(xlToLeft).Column)). _
ClearContents
For iIndex = 1 To UBound(aAusgabe)
Cells(lZeile, iIndex).Value = aAusgabe(iIndex)     ' die Spalten aus dem Array füllen
Next iIndex
Next lZeile                                              ' die nächste Zeile holen
Application.ScreenUpdating = True  ' den Bildschirm-Update wieder zulassen
End Sub


Gruß Peter

Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige