Supportnet / Forum / Tabellenkalkulation
zeilen mit gleichem zelleninhalt löschen
Frage
Hallo, ich habe eine xls die so aussieht.
also als beispiel hier mit 3 spalten:
Anmeldung/Abmeldung 528 A3109
Anmeldung/Abmeldung 528 A3109
Anmeldung/Abmeldung 528 A3109
Anmeldung/Abmeldung 528 A3109
Anmeldung/Abmeldung 528 A3110
Anmeldung/Abmeldung 528 A3110
Anmeldung/Abmeldung 528 A3110
Anmeldung/Abmeldung 528 A3110
Anmeldung/Abmeldung 528 A3111
Anmeldung/Abmeldung 528 A3111
Anmeldung/Abmeldung 528 A3111
Anmeldung/Abmeldung 528 A3111
Anmeldung/Abmeldung 528 A3111
Anmeldung/Abmeldung 528 A3121
Anmeldung/Abmeldung 528 A3121
Anmeldung/Abmeldung 528 A3121
gibt es da evtl. ein vbs, das die tabelle nach durchlauf so aussehen lässt?
Anmeldung/Abmeldung 528 A3109
Anmeldung/Abmeldung 528 A3110
Anmeldung/Abmeldung 528 A3111
Anmeldung/Abmeldung 528 A3121
also das die zeilen mit doppeltem inhalt (A3xxx) gelöscht werden, aber eine davon übrigbleibt?
Antwort 1 von nighty
hi :)
hier ein makro
in dieser zeile deine spalte gegebenenfalls aendern,ist zur zeit auf b
If Range("b" & t1%) = Range("b" & tt1%) And tt1% <> t1% Then
gruss nighty
Sub Makro1()
Set LastCell = ActiveSheet.Cells.SpecialCells(xlLastCell)
alta = LastCell.Row
a = LastCell.Row
Do While Application.CountA(Rows(a)) = 0 And a <> 1
a = a - 1
Loop
alta = a
altb = LastCell.Column
b = LastCell.Column
Do While Application.CountA(Columns(b)) = 0 And b <> 1
b = b - 1
Loop
altb = b
lzeile = alta
lspalte = altb
For t1% = 1 To lzeile
For tt1% = 1 To lzeile
If Range("b" & t1%) = Range("b" & tt1%) And tt1% <> t1% Then
Rows(tt1% & ":" & tt1%).Select
Selection.Delete Shift:=xlUp
If lzeile > 0 Then lzeile = lzeile - 1
End If
Next tt1%
Next t1%
Range("A1").Select
End Sub
hier ein makro
in dieser zeile deine spalte gegebenenfalls aendern,ist zur zeit auf b
If Range("b" & t1%) = Range("b" & tt1%) And tt1% <> t1% Then
gruss nighty
Sub Makro1()
Set LastCell = ActiveSheet.Cells.SpecialCells(xlLastCell)
alta = LastCell.Row
a = LastCell.Row
Do While Application.CountA(Rows(a)) = 0 And a <> 1
a = a - 1
Loop
alta = a
altb = LastCell.Column
b = LastCell.Column
Do While Application.CountA(Columns(b)) = 0 And b <> 1
b = b - 1
Loop
altb = b
lzeile = alta
lspalte = altb
For t1% = 1 To lzeile
For tt1% = 1 To lzeile
If Range("b" & t1%) = Range("b" & tt1%) And tt1% <> t1% Then
Rows(tt1% & ":" & tt1%).Select
Selection.Delete Shift:=xlUp
If lzeile > 0 Then lzeile = lzeile - 1
End If
Next tt1%
Next t1%
Range("A1").Select
End Sub
Antwort 2 von Aliba
Hi Frankydee,
wenn die Spalten keine Überschriften haben, dann diese bitte hinzufügen. Dann die 3 Spalten incl. Überschrichten bis zum Tabellenende markieren.
DATEN - FILTER - SPEZIALFILTER (falls eine Fehlermeldung kommt, einfach übergehen)
Es sollte nun ein Assistent geöffnet sein. Hier sollte bei Quelle bereits Dein markierter Bereich eingetragen sein.
Oben einen Haken bei: Liste an gleicher Stelle filtern
Unten einen Haken bei: keine Duplikate
OK
Die gefilterten Daten kannst Du nun in ein neues Tabellenblatt kopieren.
Anschliessend kannst Du das Originaltabellenblatt löschen, oder auch archivieren. Ganz wie du willst.
Es gibt auch die Möglichkeit die gefilterten Daten direkt in einen anderen Bereich schreiben zu lassen. Dazu muss jedoch der Spezialfilter im Zielbereich gestartet werden. Nachdem das etwas umständlicher ist, mach ich es immer mit dem Kopieren.
CU Aliba
PS Du kannst das natürlich auch als Makro aufzeichnen, wenn Du das öfter machen musst.
wenn die Spalten keine Überschriften haben, dann diese bitte hinzufügen. Dann die 3 Spalten incl. Überschrichten bis zum Tabellenende markieren.
DATEN - FILTER - SPEZIALFILTER (falls eine Fehlermeldung kommt, einfach übergehen)
Es sollte nun ein Assistent geöffnet sein. Hier sollte bei Quelle bereits Dein markierter Bereich eingetragen sein.
Oben einen Haken bei: Liste an gleicher Stelle filtern
Unten einen Haken bei: keine Duplikate
OK
Die gefilterten Daten kannst Du nun in ein neues Tabellenblatt kopieren.
Anschliessend kannst Du das Originaltabellenblatt löschen, oder auch archivieren. Ganz wie du willst.
Es gibt auch die Möglichkeit die gefilterten Daten direkt in einen anderen Bereich schreiben zu lassen. Dazu muss jedoch der Spezialfilter im Zielbereich gestartet werden. Nachdem das etwas umständlicher ist, mach ich es immer mit dem Kopieren.
CU Aliba
PS Du kannst das natürlich auch als Makro aufzeichnen, wenn Du das öfter machen musst.
Antwort 3 von nighty
hi alle :)
im obigen makro war eine feste spalte vorgegeben als suchbereich,in diesem ist eine beliebige markierte spalte der suchbereich.
gruss nighty
Sub Makro1()
ba1$ = ActiveWindow.RangeSelection.Address
Set LastCell = ActiveSheet.Cells.SpecialCells(xlLastCell)
alta = LastCell.Row
a = LastCell.Row
Do While Application.CountA(Rows(a)) = 0 And a <> 1
a = a - 1
Loop
alta = a
altb = LastCell.Column
b = LastCell.Column
Do While Application.CountA(Columns(b)) = 0 And b <> 1
b = b - 1
Loop
altb = b
lzeile = alta
lspalte = altb
For t1% = 1 To lzeile
For tt1% = 1 To lzeile
If Range("" & Mid$(ba1$, 2, 1) & t1%) = Range("" & Mid$(ba1$, 2, 1) & tt1%) And tt1% <> t1% Then
Rows(tt1% & ":" & tt1%).Select
Selection.Delete Shift:=xlUp
If lzeile > 0 Then lzeile = lzeile - 1
End If
Next tt1%
Next t1%
Range("A1").Select
End Sub
im obigen makro war eine feste spalte vorgegeben als suchbereich,in diesem ist eine beliebige markierte spalte der suchbereich.
gruss nighty
Sub Makro1()
ba1$ = ActiveWindow.RangeSelection.Address
Set LastCell = ActiveSheet.Cells.SpecialCells(xlLastCell)
alta = LastCell.Row
a = LastCell.Row
Do While Application.CountA(Rows(a)) = 0 And a <> 1
a = a - 1
Loop
alta = a
altb = LastCell.Column
b = LastCell.Column
Do While Application.CountA(Columns(b)) = 0 And b <> 1
b = b - 1
Loop
altb = b
lzeile = alta
lspalte = altb
For t1% = 1 To lzeile
For tt1% = 1 To lzeile
If Range("" & Mid$(ba1$, 2, 1) & t1%) = Range("" & Mid$(ba1$, 2, 1) & tt1%) And tt1% <> t1% Then
Rows(tt1% & ":" & tt1%).Select
Selection.Delete Shift:=xlUp
If lzeile > 0 Then lzeile = lzeile - 1
End If
Next tt1%
Next t1%
Range("A1").Select
End Sub
Antwort 4 von frankydee
vielen dank euch beiden !!!