Supportnet / Forum / Tabellenkalkulation
VBA - Excel - Zeilen aussortieren
Frage
hallo zusammen, habe folgendes problem.
ich habe ein excel sheet mit folgender tabelle
A 21 0
A 21 2
A 22 0
A 22 2
B 21 2
B 21 3
B 28 2
B 28 3
A 23 3
A 23 4
B 21 2
B 21 3
A 20 0
A 20 2
A 22 0
A 22 2
es handelt sich um ein Steuergeraet wobei die erste Spalte gibt die BOX an, die zweite Spalte gibt den Pin in der BOX an und die dritte Spalte gibt die Function (0-5) von dem jeweiligen PIN an.
Normalerweise treten die Zeilen immer paarweise auf da es darum geht zwei verschiede Steuergeraete zu kombinieren, die erste zeile ist vom Stuergeraet nummer 1 und die darunterliegende zeile immer vom steuergeraet nummer 2
die sache ist die, das excelsheet hat ueber 5000 zeilen mit immerwiederkehrenden gleichen werten.
so z.b. kommen die zwei zeilen (gehoeren zusammen)
A 21 0
A 21 2
sicherlich 50 mal in dem sheet vor. ich moechte aber in meinem neuen sheet nur noch jede der paarweisen zeilen 1 mal aufgelistet haben. d.h.
in dem neuen sheet soll die zeile
A 21 0
A 21 2
nur noch einmal drin stehen.
am ende sollte meine liste dann so aussehen
A 21 0
A 21 2
A 22 0
A 22 2
B 21 2
B 21 3
B 28 2
B 28 3
A 23 3
A 23 4
A 20 0
A 20 2
d.h. alle doppelten Zeilen(im zweierpack) sollten geloescht worden sein.
vielen dank fuer eure hilfe
andrea
Antwort 1 von nighty
hi all :)
vielleicht so :)
gruss nighty
Sub doppelte_loeschen_spalt_a_b_c()
With Worksheets(2)
Dim zaehler1 As Long
Dim zaehler2 As Long
For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
For zaehler2 = zaehler1 + 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
If Cells(zaehler2, 1).Value = Cells(zaehler1, 1).Value And _
Cells(zaehler2, 2).Value = Cells(zaehler1, 2).Value And _
Cells(zaehler2, 3).Value = Cells(zaehler1, 3).Value Then
Rows(zaehler2 & ":" & zaehler2).Delete Shift:=xlUp
End If
Next zaehler2
Next zaehler1
End With
End Sub
vielleicht so :)
gruss nighty
Sub doppelte_loeschen_spalt_a_b_c()
With Worksheets(2)
Dim zaehler1 As Long
Dim zaehler2 As Long
For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
For zaehler2 = zaehler1 + 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
If Cells(zaehler2, 1).Value = Cells(zaehler1, 1).Value And _
Cells(zaehler2, 2).Value = Cells(zaehler1, 2).Value And _
Cells(zaehler2, 3).Value = Cells(zaehler1, 3).Value Then
Rows(zaehler2 & ":" & zaehler2).Delete Shift:=xlUp
End If
Next zaehler2
Next zaehler1
End With
End Sub
Antwort 2 von nighty
hi all :)
korrigiert :)
gruss nighty
Sub doppelte_loeschen_spalt_a_b_c()
Dim zaehler1 As Long
Dim zaehler2 As Long
For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
For zaehler2 = zaehler1 + 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
If Cells(zaehler2, 1).Value = Cells(zaehler1, 1).Value And _
Cells(zaehler2, 2).Value = Cells(zaehler1, 2).Value And _
Cells(zaehler2, 3).Value = Cells(zaehler1, 3).Value Then
Rows(zaehler2 & ":" & zaehler2).Delete Shift:=xlUp
End If
Next zaehler2
Next zaehler1
End Sub
korrigiert :)
gruss nighty
Sub doppelte_loeschen_spalt_a_b_c()
Dim zaehler1 As Long
Dim zaehler2 As Long
For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
For zaehler2 = zaehler1 + 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
If Cells(zaehler2, 1).Value = Cells(zaehler1, 1).Value And _
Cells(zaehler2, 2).Value = Cells(zaehler1, 2).Value And _
Cells(zaehler2, 3).Value = Cells(zaehler1, 3).Value Then
Rows(zaehler2 & ":" & zaehler2).Delete Shift:=xlUp
End If
Next zaehler2
Next zaehler1
End Sub
Antwort 3 von schnallgonz
N´abend,
ich fasse mal zusammen:
Du möchtest alle doppelten Zeilen löschen.
Es gibt mehrere Lösungen, suche mal unter "doppelte", Dubletten" usw.
per makro oder über
DATEN--FILTER--SPEZIALFILTER
dort "keine Dublikate" anklicken
dann wahlweise
an derselben Stelle filtern, also doppelte löschen oder
an andere Stelle filtern, also Kopieren ohne Dubletten.
mfg
schnallgonz
ich fasse mal zusammen:
Du möchtest alle doppelten Zeilen löschen.
Es gibt mehrere Lösungen, suche mal unter "doppelte", Dubletten" usw.
per makro oder über
DATEN--FILTER--SPEZIALFILTER
dort "keine Dublikate" anklicken
dann wahlweise
an derselben Stelle filtern, also doppelte löschen oder
an andere Stelle filtern, also Kopieren ohne Dubletten.
mfg
schnallgonz
Antwort 4 von schnallgonz
Hi nighty,
ich sollte doch vor dem absenden aktualisieren...
muss für Dein makro nicht vorher sortiert werden?
@andrea
Meine Variante funzt nur, wenn exakt doppelte Datensätze rausfliegen sollen.
Soll schon bei Vorliegen von 2 identische Werten gelöscht werden, muss eine Makrolösung her,
siehe nighty
wobei ich meine, dass der abzusuchende Bereich sortiert sein muss.
Aber das wird der "Schleifenmeister" persönlich klären :-)
mfg
schnallgonz
ich sollte doch vor dem absenden aktualisieren...
muss für Dein makro nicht vorher sortiert werden?
@andrea
Meine Variante funzt nur, wenn exakt doppelte Datensätze rausfliegen sollen.
Soll schon bei Vorliegen von 2 identische Werten gelöscht werden, muss eine Makrolösung her,
siehe nighty
wobei ich meine, dass der abzusuchende Bereich sortiert sein muss.
Aber das wird der "Schleifenmeister" persönlich klären :-)
mfg
schnallgonz
Antwort 5 von andrea1980
das programm funktioniert leider nur teilweise.
das problem bei mir ist ja, dass ich immer die zeile im doppelpack betrachten muss.
so kann ich nicht einfach alle doppelten zeilen rausschmeisen weil z.b.
A 1 0
A 1 1
A 1 0
A 1 2
in diesem fall sollen alle vier zeilen stehen bleiben..
da ja die zeile A 1 0 im ersten block mit A 1 1 kombiniert ist und im zweiten Block ist
A 1 0 mit A 1 2 kombiniert.
mit dem programm von nighty wuerde aber die dritte zeile also A 1 0 geloescht werden.
vorgabe z.b
A 1 0
A 1 1
A 1 0
A 1 2
B 1 1
B 1 4
A 1 0
A 1 2
B 1 1
B 1 4
rausskommen soll
A 1 0
A 1 1
A 1 0
A 1 2
B 1 1
B 1 4
das problem bei mir ist ja, dass ich immer die zeile im doppelpack betrachten muss.
so kann ich nicht einfach alle doppelten zeilen rausschmeisen weil z.b.
A 1 0
A 1 1
A 1 0
A 1 2
in diesem fall sollen alle vier zeilen stehen bleiben..
da ja die zeile A 1 0 im ersten block mit A 1 1 kombiniert ist und im zweiten Block ist
A 1 0 mit A 1 2 kombiniert.
mit dem programm von nighty wuerde aber die dritte zeile also A 1 0 geloescht werden.
vorgabe z.b
A 1 0
A 1 1
A 1 0
A 1 2
B 1 1
B 1 4
A 1 0
A 1 2
B 1 1
B 1 4
rausskommen soll
A 1 0
A 1 1
A 1 0
A 1 2
B 1 1
B 1 4
Antwort 6 von schnallgonz
@nighty
ich sollte nicht nur vorab aktualisieren, sondern auch mal genau gucken;
verschachtelte Schleife, also nix sortieren (wäre hier für die tabelle auch tödlich), wieder was dazu gelernt
@andrea
scusa, habe Dich erst jetzt verstanden;
nighty wirds schon richten, hoffe ich :-)
meine Vermutung aus dem Bauch, die ich vor dem Schlafengehen nicht prüfen kann:
If Abfrage des Meisters erweitern:
If Cells(zaehler2 + 1, 1).Value = Cells(zaehler1, 1).Value And _
Cells(zaehler2 + 1, 2).Value = Cells(zaehler1, 2).Value And _
Cells(zaehler2 + 1, 3).Value = Cells(zaehler1, 3).Value And_
Cells(zaehler2 + 2, 1).Value = Cells(zaehler1 + 1, 1).Value And_
Cells(zaehler2 + 2, 2).Value = Cells(zaehler1 + 1, 2).Value And_
Cells(zaehler2 + 2, 3).Value = Cells(zaehler1 + 1, 3).Value Then
Rows(zaehler2 & ":" & zaehler2 - 1).Delete Shift:=xlUp
Nur so hingekritzelt, ich hoffe nighty sieht hier nochmal nach dem Rechten (oder rechten?)
Gute Nacht
schnallgonz
ich sollte nicht nur vorab aktualisieren, sondern auch mal genau gucken;
verschachtelte Schleife, also nix sortieren (wäre hier für die tabelle auch tödlich), wieder was dazu gelernt
@andrea
scusa, habe Dich erst jetzt verstanden;
nighty wirds schon richten, hoffe ich :-)
meine Vermutung aus dem Bauch, die ich vor dem Schlafengehen nicht prüfen kann:
If Abfrage des Meisters erweitern:
If Cells(zaehler2 + 1, 1).Value = Cells(zaehler1, 1).Value And _
Cells(zaehler2 + 1, 2).Value = Cells(zaehler1, 2).Value And _
Cells(zaehler2 + 1, 3).Value = Cells(zaehler1, 3).Value And_
Cells(zaehler2 + 2, 1).Value = Cells(zaehler1 + 1, 1).Value And_
Cells(zaehler2 + 2, 2).Value = Cells(zaehler1 + 1, 2).Value And_
Cells(zaehler2 + 2, 3).Value = Cells(zaehler1 + 1, 3).Value Then
Rows(zaehler2 & ":" & zaehler2 - 1).Delete Shift:=xlUp
Nur so hingekritzelt, ich hoffe nighty sieht hier nochmal nach dem Rechten (oder rechten?)
Gute Nacht
schnallgonz
Antwort 7 von andrea1980
hallo maenner, super sache
Sub doppelte_loeschen_spalt_a_b_c()
Dim zaehler1 As Long
Dim zaehler2 As Long
For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
For zaehler2 = zaehler1 + 2 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
If Cells(zaehler2, 1).Value = Cells(zaehler1, 1).Value And _
Cells(zaehler2, 2).Value = Cells(zaehler1, 2).Value And _
Cells(zaehler2, 3).Value = Cells(zaehler1, 3).Value And _
Cells(zaehler2 + 1, 1).Value = Cells(zaehler1 + 1, 1).Value And _
Cells(zaehler2 + 1, 2).Value = Cells(zaehler1 + 1, 2).Value And _
Cells(zaehler2 + 1, 3).Value = Cells(zaehler1 + 1, 3).Value Then
Rows(zaehler2 & ":" & zaehler2 + 1).Delete Shift:=xlUp
End If
Next zaehler2
Next zaehler1
End Sub
so funktioniert es einwandfrei
tausend dank fuer eure hilfe.
spart mir jede menge arbeit.
kuesschen andrea
Sub doppelte_loeschen_spalt_a_b_c()
Dim zaehler1 As Long
Dim zaehler2 As Long
For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
For zaehler2 = zaehler1 + 2 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
If Cells(zaehler2, 1).Value = Cells(zaehler1, 1).Value And _
Cells(zaehler2, 2).Value = Cells(zaehler1, 2).Value And _
Cells(zaehler2, 3).Value = Cells(zaehler1, 3).Value And _
Cells(zaehler2 + 1, 1).Value = Cells(zaehler1 + 1, 1).Value And _
Cells(zaehler2 + 1, 2).Value = Cells(zaehler1 + 1, 2).Value And _
Cells(zaehler2 + 1, 3).Value = Cells(zaehler1 + 1, 3).Value Then
Rows(zaehler2 & ":" & zaehler2 + 1).Delete Shift:=xlUp
End If
Next zaehler2
Next zaehler1
End Sub
so funktioniert es einwandfrei
tausend dank fuer eure hilfe.
spart mir jede menge arbeit.
kuesschen andrea
Antwort 8 von schnallgonz
Salve,
das ist Teamarbeit, der Meister gibt die Lösung vor und wir beide haben selbständig was dazugelernt.
Dank an nighty
Dank an Dich für die Rückmeldung
Gruß
schnallgonz
das ist Teamarbeit, der Meister gibt die Lösung vor und wir beide haben selbständig was dazugelernt.
Dank an nighty
Dank an Dich für die Rückmeldung
Gruß
schnallgonz
Antwort 9 von nighty
hi ihr beiden :)
nette runde :))
hilfe untereinander ob user oder moderator ist mir am liebsten und eventuelle kritik (zu meinen makros) hör ich leider viel zu selten :)))
einen schönen tag noch :))
gruss nighty
nette runde :))
hilfe untereinander ob user oder moderator ist mir am liebsten und eventuelle kritik (zu meinen makros) hör ich leider viel zu selten :)))
einen schönen tag noch :))
gruss nighty