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

Zeilen per Schleife löschen

Zeilen per Schleife löschen
21.02.2009 11:51:16
Steffen44

Hallo,
ich habe schon sehr viele Scriptbeispiele gefunden wo man leere Zeilen per Script löschen kann aber diese Beispiele konnte ich nicht meinen Bedürfnissen anpassen.
Es geht darum Zeilen zu löschen die sich innerhalb eine bestimmten Spalte befinden und einen bestimmten Inhalt haben. In meinem Fall steht in der Zelle "erfolgreich übertragen".
Da die Zeilen immer nachrutschen wenn man Sie löscht komme ich nicht weiter.
For Each i In Range(Cells(3, 3), Cells(65536, 3))
DoEvents
If i.Value = "erfolgreich übertragen" Then
i.Rows.Delete
End If
Next i
wäre toll wenn jemand einen passenden Code anbieten könnte.
Danke und Gruß
Steffen

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

Betreff
Datum
Anwender
Anzeige
Zeilen immer von unten nach oben löschen... oT
21.02.2009 11:55:45
unten
AW: Zeilen immer von unten nach oben löschen... oT
21.02.2009 12:03:42
unten
Hallo Jens,
klingt einleuchtend da ich mich mit Schleifen erst zeit kurzem beschäftige, habe nur keine Ahnung wie ich die Schleife umstellen muß damit sie von unten anfängt und sich nach oben durcharbeitet.
...oder in Schleife (von unten nach oben) so
21.02.2009 12:13:32
unten
Steffen,
Schleife von unten nach oben:

Sub ErfolgReichLöschen()
Dim lRow As Long
For lRow = ActiveSheet.Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row To 3 Step -1
If ActiveSheet.Cells(lRow, 3) = "erfolgreich übertragen" Then _
ActiveSheet.Rows(lRow).Delete
Next lRow
End Sub


GreetZ Renée

AW: Zeilen per Schleife löschen
21.02.2009 12:04:14
Josef
Hallo Steffen,
das macht man zB. so.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub loeschen()
  Dim rng As Range, rngDelete As Range, strFirst As String
  
  Set rng = Range("C:C").Find(What:="erfolgreich übertragen", LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False)
  
  If Not rng Is Nothing Then
    strFirst = rng.Address
    
    Do
      
      If rngDelete Is Nothing Then
        Set rngDelete = rng
      Else
        Set rngDelete = Union(rngDelete, rng)
      End If
      
      Set rng = Range("C:C").FindNext(rng)
      
    Loop While Not rng Is Nothing And strFirst <> rng.Address
    
  End If
  
  If Not rngDelete Is Nothing Then rngDelete.EntireRow.Delete
  
  Set rng = Nothing
  Set rngDelete = Nothing
End Sub

Gruß Sepp

Anzeige
AW: Zeilen per Schleife löschen
21.02.2009 12:17:37
Steffen44
Hallo Sepp,
das scheint ganz gut zu funktionieren auch die performance scheint ok zu sein.
Wie konntest du so schnell das Script herbeizaubern ? Ich habe lange gesucht aber nichts passendes gefunden.
Vielen Dank für eure Hilfe
Gruß
Steffen
nur eine Frage der Anschläge!
21.02.2009 12:21:04
Josef
Hallo Seffen,
diesen Code zu schreiben dauert keine zwei Minuten, und wenn man(n) richtig
Maschinenschreiben kann, dann vielleicht nur 30 Sekunden.
Gruß Sepp

...und von dem was im Kopf ist !-) (owT)
21.02.2009 12:23:44
dem

AW: ...und von dem was im Kopf ist !-) (owT)
21.02.2009 12:30:57
dem
Hi,
manchmal ist es vielleicht sogar gut, das ich nicht schneller schreiben kann.
Frei nach dem Motto: "Wie soll ich wissen was ich denke, bevor ich sehe was ich schreibe"
Gruß Sepp

Anzeige
Beide Beispiele getestet
21.02.2009 12:39:51
Steffen44
ich nochmal ;-)
so jetzt habe ich auch das Beispiel von Renée getestet und es arbeitet optisch schöner es flackert nicht wie verückt der Bildschirm weil nicht ständig die Suchfunktion aufgerufen wird und so kann man auch noch verfolgen was das Script gerade macht.
AW: Beide Beispiele getestet
21.02.2009 12:48:42
Josef
Hallo Steffen,
dem Makro beim Arbeiten zusehen, na da weiß ich was spannenderes;-))
Das Flackern lässt sich leicht vermeiden und vom Speed ist Find um Häuser schneller.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub loeschen()
  Dim rng As Range, rngDelete As Range, strFirst As String
  
  On nerror GoTo ErrExit
  GMS
  
  Set rng = Range("C:C").Find(What:="erfolgreich übertragen", LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False)
  
  If Not rng Is Nothing Then
    strFirst = rng.Address
    
    Do
      
      If rngDelete Is Nothing Then
        Set rngDelete = rng
      Else
        Set rngDelete = Union(rngDelete, rng)
      End If
      
      Set rng = Range("C:C").FindNext(rng)
      
    Loop While Not rng Is Nothing And strFirst <> rng.Address
    
  End If
  
  If Not rngDelete Is Nothing Then rngDelete.EntireRow.Delete
  
  ErrExit:
  GMS True
  Set rng = Nothing
  Set rngDelete = Nothing
End Sub

Public Sub GMS(Optional ByVal Modus As Boolean = False)
  Static lngCalc As Long
  
  With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Not Modus Then lngCalc = .Calculation
    If Modus And lngCalc = 0 Then lngCalc = -4105
    .Calculation = IIf(Modus, lngCalc, -4135)
    .Cursor = IIf(Modus, -4143, 2)
  End With
  
End Sub

Gruß Sepp

Anzeige
AW: Beide Beispiele getestet
21.02.2009 12:54:07
Nepumuk
Hallo Sepp,
was ist denn ein nerror ? (On nerror GoTo ErrExit)
Gruß
Nepumuk
nerror ist der kleine Bruder vom Error;-)
21.02.2009 12:57:16
Josef
Oups, wohl zu schnell getippt;-) (sagte ja, das ich nicht schnell tippen kann).
Danke Max, für die Aufmerksamkeit.
Hier noch Mal ohne Fehler.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub loeschen()
  Dim rng As Range, rngDelete As Range, strFirst As String
  
  On Error GoTo ErrExit
  GMS
  
  Set rng = Range("C:C").Find(What:="erfolgreich übertragen", LookAt:=xlWhole, LookIn:=xlValues, MatchCase:=False)
  
  If Not rng Is Nothing Then
    strFirst = rng.Address
    
    Do
      
      If rngDelete Is Nothing Then
        Set rngDelete = rng
      Else
        Set rngDelete = Union(rngDelete, rng)
      End If
      
      Set rng = Range("C:C").FindNext(rng)
      
    Loop While Not rng Is Nothing And strFirst <> rng.Address
    
  End If
  
  If Not rngDelete Is Nothing Then rngDelete.EntireRow.Delete
  
  ErrExit:
  GMS True
  Set rng = Nothing
  Set rngDelete = Nothing
End Sub

Public Sub GMS(Optional ByVal Modus As Boolean = False)
  Static lngCalc As Long
  
  With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Not Modus Then lngCalc = .Calculation
    If Modus And lngCalc = 0 Then lngCalc = -4105
    .Calculation = IIf(Modus, lngCalc, -4135)
    .Cursor = IIf(Modus, -4143, 2)
  End With
  
End Sub

Gruß Sepp

Anzeige
Ist eben nen'error ;-) (owT)
21.02.2009 12:57:38
Renee

AW: Beide Beispiele getestet
21.02.2009 12:59:34
Steffen44
einwandfrei Sepp läuft wirklich super schnell und ohne komisches rumgeflacker :-)
was genau macht der Abschnitt :
With Application
.ScreenUpdating = Modus
.EnableEvents = Modus
.DisplayAlerts = Modus
.EnableCancelKey = IIf(Modus, 1, 0)
If Not Modus Then lngCalc = .Calculation
If Modus And lngCalc = 0 Then lngCalc = -4105
.Calculation = IIf(Modus, lngCalc, -4135)
.Cursor = IIf(Modus, -4143, 2)
End With
eigentlich genau und warum wird da auf -4105 verglichen ?
AW: Beide Beispiele getestet
21.02.2009 13:10:46
Josef
Hallo Steffen,
das ist eine kleine Subroutine, um Excel "ruhig" zu stellen.
Public Sub GMS(Optional ByVal Modus As Boolean = False)
  Static lngCalc As Long
  
  With Application
    .ScreenUpdating = Modus 'Bildschirmaktualisierung ein/aus
    .EnableEvents = Modus 'Ereignisprozeduren ein/aus
    .DisplayAlerts = Modus 'Meldungen ein/aus
    .EnableCancelKey = IIf(Modus, 1, 0) 'Unterbrechen mit ESC oder STRG+Unterbr. ein/aus
    If Not Modus Then lngCalc = .Calculation 'Aktuellen Berechnungsmodus merken
    If Modus And lngCalc = 0 Then lngCalc = -4105
    '-4105 ist der Wert der vbKonstanten xlCalculationAutomatic
    '-4135 ist der Wert von xlCalculationManual
    .Calculation = IIf(Modus, lngCalc, -4135) 'Automatische Berechnung je nach Modus ein/aus
    .Cursor = IIf(Modus, -4143, 2) 'Cursor ändern
  End With
  
End Sub

Gruß Sepp

Anzeige
Schon wieder erwischt
21.02.2009 13:23:19
Nepumuk
Hallo Sepp,

ist der Wert der vbKonstanten xlCalculationAutomatic


vbKonstanten haben den Präfix vb an (vbYes, vbCritical, vb3DDKShadow, vbHidden .......). Konstanten mit dem Präfix xl sind reine Excelkonstanten.
Officekonstanten beginnen mit mso, Userformkonstanten mit fm, ClipBoardkonstanten mit cc, Treeviewkonstanten mit tvw, Listviewkonstanten mit lvw ......
Gruß
Nepumuk

AW: Schon wieder erwischt
21.02.2009 14:10:18
Josef
Hi Max,
heute schreib ich anscheinend wirklich schneller als ich denke;-((
Seisdrum, das Grundprinzip wird Steffen damit schon klar werden.
Gruß Sepp

Anzeige
AW: mit Application.Match
21.02.2009 13:14:40
Erich
Hi Steffen,
teste doch auch mal diese Version:

Option Explicit
Sub Delete_All_Match()
Dim rngM As Range, rngE As Range, lngZ As Long, varZ 'As Variant
Set rngM = Columns(3)
varZ = Application.Match("erfolgreich übertragen", rngM, 0)
Do While IsNumeric(varZ)
lngZ = CLng(varZ) + rngM.Row - 1
If rngE Is Nothing Then
Set rngE = Cells(lngZ, 1)
Else
Set rngE = Union(rngE, Cells(lngZ, 1))
End If
If lngZ >= Rows.Count Then Exit Do
Set rngM = Range(Cells(lngZ + 1, 3), Cells(Rows.Count, 3))
varZ = Application.Match("erfolgreich übertragen", rngM, 0)
Loop
If Not rngE Is Nothing Then rngE.EntireRow.Delete
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: mit Application.Match
21.02.2009 13:44:03
Steffen44
Hallo Erich,
das Script verrichtet ebenfalls sein Arbeit gut obwohl ich nicht verstehe auf welcher Basis es funktioniert und es für mich doch relativ schwer zu durchschauen und anzupassen ist. Vom Gefühl her arbeitet es nur minimal langsamer als die Methode mit .find.
Besten Dank für eure Hilfe
Gruß
Steffen
AW: Zeilen per Schleife löschen wozu ?
21.02.2009 15:25:53
Daniel
Hi Steffen
das löschen von Zeilen per Schleife ist höchst ineffektiv weil langsam.
da gibt doch so schöne Werkzeuge die man nutzen kann wie den Autofilter

Sub Makro1()
Columns("C:C").AutoFilter Field:=1, Criteria1:="erfolgreich übertragen"
Range("C2:C65536").SpecialCells(xlCellTypeVisible).EntireRow.Delete
Columns("C:C").AutoFilter
End Sub


oder diese Methode (die allerdings nur funktioniert, wenn "erfolgreich übertragen" als echter Text in der Zelle steht und nicht als Formel)


Sub Makro2()
With Columns("C:C")
.Replace "erfolgreich übertragen", True
.SpecialCells(xlCellTypeConstants, 4).EntireRow.Delete
End With
End Sub


diese beiden Methoden sind deutlich schneller als eine schleife und bei grösseren Datenmengen (mehrere tausend Zeilen) sogar von Hand ohne Makro schneller als ein Schleifenmakrol
bei sehr grossen Datenmengen (> 16.000 Zeilen) empfiehlt es sich, die Daten vorher noch zu sortieren, so daß alle zu löschenden Zeilen direkt untereinander stehen.
dann lassen sich auch Tabellen mit 65.000 Zeilen in sekundenbruchteilen bearbeiten.
Gruß, Daniel

Anzeige
AW: Zeilen per Schleife löschen wozu ?
21.02.2009 16:37:04
zeljko

Sub supetar()
'www.croexcel.com
'croexcel@croexcel.com
'Bralic Zeljko
With Range("C:C")
.Replace What:=1, Replacement:="", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
.Sort Key1:=Range("c1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
End Sub


Gruß

AW: Zeilen per Schleife löschen wozu ?
21.02.2009 16:42:44
zeljko
Sorry,

Sub supetar()
'www.croexcel.com
'croexcel@croexcel.com
'Bralic Zeljko
With Range("C:C")
.Replace What:="erfolgreich übertragen", Replacement:="", LookAt:=xlWhole, SearchOrder:= _
xlByRows, MatchCase:=False
.Sort Key1:=Range("c1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
End Sub


Gruß

Anzeige
Danke
21.02.2009 17:08:45
Steffen44
Hallo Daniel,
deine Scripte sehen gut aus schön kurz und effektiv
wo du recht hast hast du recht auf die Idee mit den Autofilter bin ich noch gar nicht gekommen da ich mich bis jetzt nur auf Schleifen versteift habe und das zweite Sctipt kann ich auch verwenden da ich "erfolgreich übertragen" per Schleife in die Zelle schreiben lasse wird es nie eine Formel sein.
Besten Dank für deine Hilfe
Gruß
Steffen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige