Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1080to1084
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

Leere Zellen löschen wenn

Leere Zellen löschen wenn
14.06.2009 14:16:37
walli
Hallo Fachfrauen u. Männer,
ich möchte gern zellen löschen wenn beide Spalten Leerzellen sind.
Beispiel:
In an D5 u. E5 stehen zahlen
D6 u. E6 stehen keine zahlen dann bitte beide also d+E nnach oben schieben
siehe Beispiel Mappe:
https://www.herber.de/bbs/user/62422.xls
mfg walli

23
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Leere Zellen löschen wenn
14.06.2009 14:35:22
Christian
Hallo,
Bsp hierzu findest du hundertfach im Archiv.

Option Explicit
Sub DelRows()
Dim lngLR&, i&
Application.ScreenUpdating = False
With ActiveSheet
lngLR = .Cells.Find("*", , xlValues, 2, 1, 2, 0, 0).Row
For i = lngLR To 6 Step -1
If .Cells(i, 4) = "" And .Cells(i, 5) = "" Then .Cells(i, 4).Resize(, 2).Delete
Next
End With
Application.ScreenUpdating = True
End Sub

Gruß
Christian

AW: Leere Zellen löschen wenn
14.06.2009 14:49:24
walli
Hallo Christian,
das stimmt zwar aber nicht mit 2 Spalten.
Das Makro läuft unendlich, die letzte Zelle die in der Spalte N
steht sollte das Ende sein.
Kannst Du bitte nochmal schauen ?
mfg walli
Anzeige
AW: Leere Zellen löschen wenn
14.06.2009 15:14:08
Christian
Hallo,
ersetze die Zeile:
lngLR = .Cells.Find("*", , xlValues, 2, 1, 2, 0, 0).Row
mit:
lngLR = .Cells(.Rows.Count, 14).End(xlUp).Row
Dann wird die letzte beschriebene Zelle aus Spalte "N" (=14) als Grenze genommen.
Gruß Christian
AW: als Einzeler
14.06.2009 14:44:16
Daniel
Hi
über die SpecialCells-Methode kannst du aufwendige Schleifen vermeiden und das ganze als Einzeiler schreiben:

Sub Löschen()
Intersect(Columns(4).SpecialCells(xlCellTypeBlanks).EntireRow, _
Columns(5).SpecialCells(xlCellTypeBlanks).EntireRow, _
Range("6:" & Rows.Count)).EntireRow.Delete
End Sub


Gruß, Daniel

Anzeige
AW: On Error Resume Next o.T.
14.06.2009 15:29:27
Gerd
Gruß Gerd
On Error Resume Next Wohin ?
14.06.2009 15:44:19
walli
Hallo Daniel u. Gerd,
wo setze ich den dies hin ?
On Error Resume Next
Habe festgestellt das die Spalten 1-3 ebenfalls die Daten jetzt nicht mehr stimmen,
Warum ?
Wenn ich händig Zeile löschen und nach oben verschieben
bleiben die Daten davor erhalten.
mfg Walter
Daniel habe mal so aber leider auch
14.06.2009 16:19:09
walli
Hallo Daniel,
habe mal so geändert: deLete Shift:=xlUp
aber es werden immer die ganzen Zeilen davor verschoben.
Intersect(Columns(14).SpecialCells(xlCellTypeBlanks).EntireRow, _
Columns(15).SpecialCells(xlCellTypeBlanks).EntireRow, _
Range("6:" & Rows.Count)).EntireRow.deLete Shift:=xlUp
Warum denn ?
mfg walli
Anzeige
AW: C+D=leer unter Zeile 5 löschen
14.06.2009 16:59:06
Gerd
Hallo Walli!
die SpecialCells u. was dazugehört sind etwas kippelig. :-)

Sub Makro2()
Dim Z As Integer
For Z = Application.Max(6, Range("D65536").End(xlUp).Row) To 6 Step -1
If Len(Range("D" & Z)) * Len(Range("E" & Z)) = 0 Then
Range("D" & Z).Resize(1, 2).Delete shift:=xlUp
End If
Next
End Sub


Gruß Gerd

Danke Gerd !!! -)
14.06.2009 18:13:24
walli
Guten Abend Gerd,
das ist prima,
danke
mfg walli
Dann war aber Deine Vorgabe irreführend !
14.06.2009 18:31:04
Matthias
Hallo
Siehe Ausgangsfrage, da hast Du in der Datei ganz klar dargestellt wie Du Dir das Ergebnis vorstellst.
Userbild
Anzeige
Hallo Matthias bei mir
14.06.2009 18:49:20
walli
hallo Matthias,
bei mir ist das kommmmischerweise so wie ich das haben wollte.
Ich habe gerad mal mit anderer Spalte getestet, ebenfalls,
allerdings dauert es sehr lange.
Es wird von unten nach oben die Zeile von Spalte N:O nach oben geschoben, wenn in der Zelle der
Spalte N nichts drin steht.
Die Spalten A bis M werden nicht verändert !
Hier das geänderte Makro:
Dim ZL As Integer
For ZL = Application.Max(6, Range("N65536").End(xlUp).Row) To 6 Step -1
If Len(Range("N" & ZL)) * Len(Range("N" & ZL)) = 0 Then
Range("N" & ZL).Resize(1, 2).deLete shift:=xlUp
End If
Next
mfg walli
Anzeige
klappt es so ...
14.06.2009 18:16:45
Matthias
Hallo

Sub walli()
Dim lox&
For lox = 23 To 6 Step -1
If IsEmpty(Cells(lox, 4)) And IsEmpty(Cells(lox, 5)) Then Rows(lox).Delete
Next
End Sub


Gruß Matthias

Leider nicht
14.06.2009 18:59:46
walli
Hallo Matthias,
machte plötzlich halt.
Dieses Makro von Matthias lief soweit gut, (schnell) allerdings
wurde dann die Zeile davor auch gelöscht z.b. wie ich gerade getest habe,
von A bis M.
mfg walli
AW: Leider nicht
14.06.2009 19:09:25
Gerd
Hi,
A und M sind Spaltenbezeichnungen. Von Massendatenverarbeitung war noch nicht die Rede :-)
4= Spalte D in "Cells" , 5= Spalte E

Sub walli4()
Dim lox&
For lox = 23 To 6 Step -1
If IsEmpty(Cells(lox, 4)) And IsEmpty(Cells(lox, 5)) Then Range(Cells(lox,4),Cells(lox,4)). _
Delete
Next
End Sub


Gruß Gerd

Anzeige
Hallo Gerd sehr langsam
14.06.2009 19:25:51
walli
Hallo Gerd,
habe dies mal für die Spalte 14 + 15 geändert,
es dauert sehr lang.
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim lox&
For lox = 500 To 6 Step -1
If IsEmpty(Cells(lox, 14)) And IsEmpty(Cells(lox, 15)) Then Range(Cells(lox, 14), Cells(lox, 15)). _
deLete
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Es soll ja nur die Zeile von Spalte 14+ 15 gelöscht werden, wenn die Zelle
in der Spalte 14 lehr ist.
mfg walli
weniger als 1 Sek bei 1000 Zeilen
14.06.2009 19:41:02
Matthias
Hallo
Der Code läuft bei mir mit 1000 Zeilen weniger als 1 Sekunde. Du schreibst von nur 500 Zeilen
Magst Du das Sheet mal hochladen.
Ich glaube so kommnen wir nicht weiter.
Gruß Matthias
Anzeige
AW: weniger als 1 Sek bei 1000 Zeilen
14.06.2009 19:49:27
walli
Hallo Matthias,
IHR habr ja auch viel GEDULD, DANKE !
Anbei die Musterdatei, allerdings sind in der Orginaldatei viele Daten noch mit Formeln
etc., vielleicht ist es deshalb so langsam ?
https://www.herber.de/bbs/user/62424.xls
mfg walli
das klappt doch perfekt ...
14.06.2009 19:58:45
Matthias
Hallo
... auch in Deiner Datei
Einfach den Code in ein Modul

Sub walli()
Dim lox&
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For lox = 500 To 6 Step -1
If IsEmpty(Cells(lox, 14)) And IsEmpty(Cells(lox, 15)) Then Range(Cells(lox, 14), Cells(lox,  _
15)).Delete
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "fertig !"
End Sub


Userbild
Gruß Matthias

Anzeige
Das war aber ein ... -))))
14.06.2009 21:50:14
walli
Guten Abend Matthias,
das war ein hartes Stück ARBEIT von Dir !!!
Danke !
Ich weiß nicht warum aber es geht tatsächlich sehr SCHNELLLLL !
Danke nochmals
mfg walli
Danke, fürs Feedback :o)
15.06.2009 16:23:03
Matthias
nicht ganze Zeilen löschen
15.06.2009 18:55:42
Daniel
Hi
die ganzen Zeilen werden gelöscht, weil ich das so geschrieben habe.
aus deinem Beispiel und deiner Beschreibung war wahrscheinlich nicht deutlich genug ersichtlich, daß die Zellbereiche drumherum nicht geändert werden dürfen
so sollte es funktionieren, daß die Zellen nur in den Spalten D und E gelöscht werden:

Sub Löschen()
Intersect(Columns(4).SpecialCells(xlCellTypeBlanks).EntireRow, _
Columns(5).SpecialCells(xlCellTypeBlanks).EntireRow, _
Range("6:" & Rows.Count), Range("D:E")).Delete Shift:=xlup
End Sub


ein On Error Resume Next könnte man noch einbauen, weil die Specialcells-Funktion sonst mit einem Fehler abbricht, wenn keine passenden Zellen gefunden werden:


Sub Löschen()
on error resume next
Intersect(Columns(4).SpecialCells(xlCellTypeBlanks).EntireRow, _
Columns(5).SpecialCells(xlCellTypeBlanks).EntireRow, _
Range("6:" & Rows.Count), Range("D:E")).Delete Shift:=xlup
on error goto 0
End Sub


mit "on error" sollte man aber vorsichtig umgehen und nur die Codezeilen darin kapseln, die auch einen Fehler verursachen dürfen.
Gruß, Daniel

Anzeige
Hallo Daniel auch SUPER -)
15.06.2009 20:00:14
walli
Hallo Daniel,
auch Dir nochmal DANKE, deins ist ebenfalls sehr schnell !!!!
mfg walli

334 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige