Anzeige
Archiv - Navigation
880to884
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
880to884
880to884
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Ganze Zeile löschen anhand von Bedingungen

Ganze Zeile löschen anhand von Bedingungen
26.06.2007 17:06:47
Bedingungen
Hallo zusammen!
Ich suche verzweifelt nach einer VBA Lösung für folgendes Problem:
Ich habe folgende Tabelle (bzw. ca. 400 Stück vom gleichen Typ):
ABCDEFGHIJK
1BelegVerkaufsauftragLieferterminBelegartHerstellungs- mengeRestmengeStart- datumEnd- datumRessourcennr.BeschreibungProduktionsstatus
2147304-00114730411.07.2007Arbeitsgang 04.04.200704.04.2007800VorbereitungFertig
3147304-00114730411.07.2007Arbeitsgang 12.04.200712.04.2007260DP - Presse 10Fertig
4147304-00114730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
5147304-00214730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
6147304-00314730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
7147304-00314730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
8147304-00114730411.07.2007Arbeitsgang 04.04.200704.04.2007800VorbereitungFertig
9147304-00114730411.07.2007Arbeitsgang 12.04.200712.04.2007260DP - Presse 10Fertig
10147304-00114730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
11147304-00214730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
12147304-00314730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
13147304-01014730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
14147304-01114730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
15147304-01114730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
16147304-00914730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
17147304-01014730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
18147304-01114730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
19147304-01714730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
20147304-01814730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
21147304-01814730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
22147304-03114730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
23147304-01714730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
24147304-01814730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
25147304-02414730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
26147304-02514730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
27147304-02514730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
28147304-02314730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
29147304-02414730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
30147304-02514730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen



Ich möchte nun das das Makro in der Spalte J nachsieht, ob zweimal in folge das Wort Endkontrolle vorkommt. Wenn dem so ist soll die zweite Zeile mit dem Wort komplett gelöscht werden.
Nun sollte die Tabelle so aussehen:
ABCDEFGHIJK
1BelegVerkaufsauftragLieferterminBelegartHerstellungs- mengeRestmengeStart- datumEnd- datumRessourcennr.BeschreibungProduktionsstatus
2147304-00114730411.07.2007Arbeitsgang 04.04.200704.04.2007800VorbereitungFertig
3147304-00114730411.07.2007Arbeitsgang 12.04.200712.04.2007260DP - Presse 10Fertig
4147304-00114730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen
5147304-00114730411.07.2007Arbeitsgang 04.04.200704.04.2007800VorbereitungFertig
6147304-00114730411.07.2007Arbeitsgang 12.04.200712.04.2007260DP - Presse 10Fertig
7147304-00114730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen



Nun soll das Makro in der Spalte A nachsehen, ob die gleiche Zahl (in diesem fall 147304-001) mehr als 3 mal in folge angezeigt wird. Is dem so, sollen alle weiteren mit dieser Zahl gelöscht werden (also in diesem Fall sollen die ersten 3 Zeile bestehen bleiben in die anderen 3 gelöscht werden).#
Das Ergebnis soll dann so aussehen:
ABCDEFGHIJK
1BelegVerkaufsauftragLieferterminBelegartHerstellungs- mengeRestmengeStart- datumEnd- datumRessourcennr.BeschreibungProduktionsstatus
2147304-00114730411.07.2007Arbeitsgang 04.04.200704.04.2007800VorbereitungFertig
3147304-00114730411.07.2007Arbeitsgang 12.04.200712.04.2007260DP - Presse 10Fertig
4147304-00114730411.07.2007Arbeitsgang 27.06.2007 991Endkontrollenicht begonnen



Wäre Super wenn mir hier jemand mit einem kleine VBA Text helfen könnte!!
Danke!!!

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ganze Zeile löschen anhand von Bedingungen
26.06.2007 18:06:00
Bedingungen
Hallo,
schau mal ob dies so funktioniert

Sub Makro1()
Dim a As Variant, b As Variant
For a = 1 To Range("j20000").End(xlUp).Row
If Cells(a, 11) = "Endkontrolle" And Cells(a + 1, 11) = "Endkontrolle" Then
Rows(Cells(a + 1, 11).Row).Delete Shift:=xlUp
a = a - 1
End If
Next a
For a = 1 To Range("a20000").End(xlUp).Row
If Cells(a, 2) = "147304-001" And Cells(a + 1, 2) = "147304-001" And Cells(a + 2, 2) = "147304- _
001" Then
For b = 1 To Range("a20000").End(xlUp).Row
If Cells(a + b + 2, 2) = "147304-001" Then
Rows(Cells(a + b + 2, 2).Row).Delete Shift:=xlUp
b = b - 1
End If
Next b
Exit For
End If
Next a
End Sub


Gruss
Tino

Anzeige
AW: Ganze Zeile löschen anhand von Bedingungen
26.06.2007 18:09:24
Bedingungen
Hallo,
habe vergessen den Code wieder auf deine Tabellenangaben umzustellen.

Sub Makro1()
Dim a As Variant, b As Variant
For a = 1 To Range("j20000").End(xlUp).Row
If Cells(a, 10) = "Endkontrolle" And Cells(a + 1, 10) = "Endkontrolle" Then
Rows(Cells(a + 1, 10).Row).Delete Shift:=xlUp
a = a - 1
End If
Next a
For a = 1 To Range("a20000").End(xlUp).Row
If Cells(a, 1) = "147304-001" And Cells(a + 1, 1) = "147304-001" And Cells(a + 2, 1) = "147304- _
001" Then
For b = 1 To Range("a20000").End(xlUp).Row
If Cells(a + b + 2, 1) = "147304-001" Then
Rows(Cells(a + b + 2, 1).Row).Delete Shift:=xlUp
b = b - 1
End If
Next b
Exit For
End If
Next a
End Sub


Gruss
Tino

Anzeige
AW: Ganze Zeile löschen anhand von Bedingungen
27.06.2007 07:49:47
Bedingungen
Hi Tino.
Danke erstmal für die schnelle Antwort.
Dein Makro funktioniert soweit. Jedoch lässt es sich leider nicht auf meine anderen Tabellen anwenden, weil Du für die letzte Funktion (nachsehen ob die Nummer 3x in folge Auftritt - dann alle weiteren mit gleicher Nummer löschen) direkt die Werte aus der Tabelle genommen hast. Diese sind jedoch Variabel. D.H. in der Spalte A könnte auch der Wert 123456-001 stehen (Diese Zahl ändert sich immer).
Vielleicht fällt Dir hierzu ja noch was ein.
Gruß
Christian

AW: Ganze Zeile löschen anhand von Bedingungen
27.06.2007 08:27:33
Bedingungen
Servus,
hab ich das richtig verstanden?
Du willst statt :
If cells(a, 1) = "147304-001" And... für "147304-001" eine Variable haben.
wenn ja, dann schreib oben:
Dim zahl As String und ersetze die Zahlen durch die Variable. Zwischen die For-Schleifen musst du eine InputBox einbauen:
zahl = InputBox("Bitte Suchstring eingeben!").
Gruß
Chaos

Anzeige
AW: Ganze Zeile löschen anhand von Bedingungen
27.06.2007 10:22:00
Bedingungen
Hi Leute,
ich muß ja erst mal meinen Dank an alle ausprechen, die in diesem Forum aktiv sind. Es ist schon ne tolle Sache das unwissende (wie ich) hier ihre Fragen stellen können und ihr euch die Zeit nehmt diese zu beantworten.
Zu meinem Problem:
Ich habs mit einem anderem Makro hinbekommen:

Sub Test()
Application.ScreenUpdating = False
Dim wks As Worksheet
Dim i As Variant
Dim a As Variant
Set wks = Sheets(1)   'hier anpassen
anz = wks.Cells(65536, 10).End(xlUp).Row
For i = 1 To anz
If Cells(i, 10) = "Endkontrolle" Then
Do
If Cells(i, 10).Offset(1, 0) = Cells(i, 10) Then
Rows(i + 1).Delete shift:=xlUp
End If
Loop Until Cells(i, 10).Offset(1, 0)  Cells(i, 10)
End If
Next i
a = 1
Do
If Cells(a, 1) = Cells(a, 1).Offset(1, 0) Then
If Cells(a, 1) = Cells(a, 1).Offset(2, 0) Then
Do
Rows(a + 3).Delete shift:=xlUp
Loop Until Cells(a, 1).Offset(3, 0) = ""
End If
End If
a = a + 1
Loop Until Cells(a, 1) = ""
Application.ScreenUpdating = True
End Sub


Dieses Makro macht genau was ich beschrieben habe.
Trotzdem danke an alle.

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige