Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1500to1504
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
Inhaltsverzeichnis

Problem beim löschen von Zeilen

Problem beim löschen von Zeilen
29.06.2016 17:26:56
Zeilen
Hallo,
ich hoffe mir kann hier jemand helfen, ich sehe wahrscheinlich den Wald vor lauter Bäumen nicht mehr.
Folgendes Scenario:
Ich suche einen Wert aus einer Zelle in der Arbeitsmappe 1 in einem Range in der Arbeitsmappe zwei. Wenn es diesen Wert in dem Range nicht gibt, dann soll er aus der Arbeitsmappe 1 die Zeile wo sich der Wert befindet löschen. Dies mache ich in 4 verschiedenen Arbeitsmappen aber immer im gleichen Range. Vorher schaue ich noch wie viele Zeilen eigentlich belegt sind in den jeweiligen Arbeitsmappen, weil sich das immer ändern kann.
Folgender Code dazu:

'Löschen von Einträgen die nicht mehr vorhanden sind bzw. den Bezirk gewechselt haben
aZeilen1 = Worksheets(district1).Range("A65535").End(xlUp).Row 'Anzahl der belegten Zeilen  _
ermitteln
aZeilen2 = Worksheets(district2).Range("A65535").End(xlUp).Row
aZeilen3 = Worksheets(district3).Range("A65535").End(xlUp).Row
aZeilen4 = Worksheets(district4).Range("A65535").End(xlUp).Row
For i = 2 To aZeilen1
If Worksheets("Daten_Quarz").Range("Q:Q").Find(Worksheets(district1).Cells(i, 17)) Is  _
Nothing Then
Worksheets(district1).Rows(i).Delete
End If
Next i
For i = 2 To aZeilen2
If Worksheets("Daten_Quarz").Range("Q:Q").Find(Worksheets(district2).Cells(i, 17)) Is  _
Nothing Then
Worksheets(district2).Rows(i).Delete
End If
Next i
For i = 2 To aZeilen3
If Worksheets("Daten_Quarz").Range("Q:Q").Find(Worksheets(district3).Cells(i, 17)) Is  _
Nothing Then
Worksheets(district3).Rows(i).Delete
End If
Next i
For i = 2 To aZeilen4
If Worksheets("Daten_Quarz").Range("Q:Q").Find(Worksheets(district4).Cells(i, 17)) Is  _
Nothing Then
Worksheets(district4).Rows(i).Delete
End If
Next i

Problem:
Er löscht mir nicht alle Zeilen raus, in denen sich Inhalt befinden wo der Wert aus Cells(i, 17) nicht gefunden wird in dem Range("Q:Q") beim ersten mal. Ich muss das mehrfach ausführen, bis alles weg ist, was nicht mehr rein gehört. Je nachdem wie viel drin ist, kann es manchmal sein, dass ich das 2mal oder auch 4mal ausführen muss.
Weiß jemand Rat, woran es liegen könnte? Eventuell Speicherauslastung oder ähnliches?
Danke für die HILFE

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

Betreff
Datum
Anwender
Anzeige
AW: Problem beim löschen von Zeilen
29.06.2016 17:32:31
Zeilen
Hallo Sven,
du musst Schleife zum Löschen von hinten nach vorne laufen lassen
For i = aZeilen1 To 2 Step -1
If Worksheets("Daten_Quarz").Range("Q:Q").Find(Worksheets(district1).Cells(i, 17)) Is  _
Nothing Then
Worksheets(district1).Rows(i).Delete
End If
Next i
Gruß Werner

AW: Problem beim löschen von Zeilen
29.06.2016 17:40:18
Zeilen
Hallo Sven,
vielleicht sollte ich dir auch noch sagen warum.
Sonst gibt es immer Probleme wenn mehrere aufeinander folgende Zeilen die Bedingung zum Löschen erfüllen.
Beispiel: deine Variable i hat den Wert 3, der Code befindet sich also in Zeile 3
Diese Zeile muss gelöscht werden. Jetzt Rücken alle nachfolgenden Zeilen nach oben, Zeile 4 wird jetzt also zu Zeile 3. Wenn die jetzt aber auch gelöscht werden muss dann wird sie vom Code übergangen. Der Code hat ja Zeile 3 schon abgearbeitet und macht mit Zeile 4 weiter. Die vorherige (auch zu löschende) Zeile 4 ist aber jetzt ja Zeile 3.
Gruß Werner

Anzeige
AW: Problem beim löschen von Zeilen
30.06.2016 19:20:42
Zeilen
Vielen Vielen Dank für Eure Hilfe - hätte ich eigentlich auch mal selbst drauf kommen können, zumindest das was Werner gesagt hat :(

AW: Gerne u. Danke für die Rückmeldung. o.w.T
30.06.2016 20:40:41
Werner

schnell mit Dic
29.06.2016 18:03:29
Michael
Hi Sven,
das geht viel einfacher:
Option Explicit
Sub Dic_Michael()
Dim DQ As Variant
Dim lZ&      ' letzteZeile, & = as long
Dim i&, aZ1&, k&
Dim o As Object
Const District1 = "District1"
Const vZ = 1 ' von Zeile in Daten_Quarz, falls Überschriften eben >1
Set o = CreateObject("scripting.dictionary")
lZ = Worksheets("Daten_Quarz").Range("Q" & Rows.Count).End(xlUp).Row
DQ = Worksheets("Daten_Quarz").Range("Q1:Q" & lZ) ' hier IMMER Q1 !!!
For i = vZ To lZ
o(DQ(i, 1)) = 1
Next
MsgBox o.Count & " EINDEUTIGE Daten in Daten_Quarz"
aZ1 = Worksheets(District1).Range("Q" & Rows.Count).End(xlUp).Row
DQ = Worksheets(District1).Range("Q1:Q" & aZ1)
'Stop
For i = aZ1 To 2 Step -1
If Not o.exists(DQ(i, 1)) Then Worksheets(District1).Rows(i).Delete: k = k + 1
Next i
' hier eben die weiteren 3 Blätter analog
MsgBox k & " Zeilen gelöscht"
End Sub
Datei: https://www.herber.de/bbs/user/106625.xlsm
Schöne Grüße,
Michael

Anzeige
AW: schnell mit Dic
30.06.2016 19:23:05
Sven
Hallo Michael,
vielen Dank für Deine Idee, ich werde mir das nächste Woche nochmal in Ruhe anschauen und ggf. umsetzen. Vielen Dank für die Mühe

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige