Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Mit Schleife Zeilen markieren und am Ende alle selektierten Zeilen löschen
#1
Hallo liebe Community,

ich bin am Ende meines Lateins und die Suchmaschinen spucken mir nichts brauchbares aus.
Ich durchsuche mit einer Schleife eine Spalte, immer wenn er einen bestimmten Wert findet soll er die ganze Zeile markieren.
Am Ende sollten mehrere Zeilen markiert sein, die ich dann auf einen Schwups löschen kann.

Was ich nicht hinkriege ist, wie er die Markierung um die nächste Zeile erweitert (So wie wenn ich manuell mit STRG markiere).

Hier der Code in Entstehung.

Danke vielmals & Grüße
Martin

Code:
Sub Archivieren()
Dim s, o, Formel1, Formel2, Selektion

Application.ScreenUpdating = False
For s = 5 To 500 'PROBLEM: Er löscht immer eine Zeile, danach springt er aber eine Zeile vor
If Not ThisWorkbook.Sheets("Mängel").Range("N" & s) = "" And Not ThisWorkbook.Sheets("Mängel").Range("N" & s) = "verlängert" Then
   ThisWorkbook.Sheets("Mängel").Range("B" & s & ":O" & s).Copy
   
   Set Selektion = Union(ThisWorkbook.Sheets("Mängel").Range("B" & s & ":O" & s), ThisWorkbook.Sheets("Mängel").Range("B" & s & ":O" & s))
   Selektion.Select
   
   ThisWorkbook.Sheets("Mängel").Range("B" & s & ":O" & s).Select
   ThisWorkbook.Sheets("Archiv").Cells(3, 2).End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
   'ThisWorkbook.Sheets("Mängel").Rows(s).Delete shift:=xlUp
   Else
End If

Next s

ThisWorkbook.Sheets("Mängel").Range("F5:G500").Font.FontStyle = "Bold"
ThisWorkbook.Sheets("Mängel").Range("O5:O500").Font.Size = 20


For o = 5 To 500
Formel1 = "=WENN(N" & o & ";1;0)"
Formel2 = "=WENN(ISTFEHLER($R$" & o & ");0;WENN($N$" & o & ";1;0))"
ThisWorkbook.Sheets("Mängel").Range("$R$" & o & "").FormulaLocal = Formel1
ThisWorkbook.Sheets("Mängel").Range("$S$" & o & "").FormulaLocal = Formel2
Next o

Sheets("Mängel").Activate
Application.ScreenUpdating = True


End Sub
Antworten Top
#2
Hallöchen,

beim Zeilen löschen wie Du es machst "überholt" sich Excel … Nimm die Schleife anders herum
From 500 To 5 Step -1
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
[-] Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:
  • kliffi01
Antworten Top
#3
Hallo,

warum nicht mit dem Filter und dann beim Filterergebnis die entsprechenden Zeile löschen?

Gruß Werner
[-] Folgende(r) 1 Nutzer sagt Danke an Werner.M für diesen Beitrag:
  • kliffi01
Antworten Top
#4
Danke für die Tipps. Ein Problem ist behoben.

Die Idee mit dem Filter ist total gut, aber wie setze ich das um. Ich finde in der Suchmaschine immer nur Vorschläge wenn man nach bestimmten Datums sucht, ich möchte grundsätzlich alles was ein Datum ist filtern.

Code:
Datum = ThisWorkbook.Sheets("Mängel").Range("B" & s & ":O" & s).Value

   ThisWorkbook.Sheets("Mängel").Range("B4:O4").AutoFilter Field:=13, Criteria1:=Datum

Das funktioniert nicht, weil er in Datum ja die Schleife durchläuft und so sollte es auch nicht sein.
Wie kann ich als Criteria1 grundsätzlich jedes Datum definieren?

Danke und Grüße
Martin
Antworten Top
#5
Hallo,

da kann ich den Vorredner nur unterstützen: Zeilenweise zu löschen ist sehr langsam und nur bei kleinen Datensätzen eine Möglichkeit.

Extrem schnell löschen geht, mit einer Formel oder VBA in einer Hilfsspalte alle zu löschenden Zeilen eine 0, allern anderen Zeilen einen anderen Wert zuzuweisen. Dann kann man mit "RemoveDuplicate" auch mehrere 100.000 Datensätzen in wenigen Sekunden löschen.

mfg

(falls weitere Unterstützung notwendig erscheint, geht das nur mit einer Beispieldatei)
[-] Folgende(r) 1 Nutzer sagt Danke an Fennek für diesen Beitrag:
  • kliffi01
Antworten Top
#6
Danke Fennek.

Das Datumproblem hab ich nun anders gelöst: Ich suche alle Daten kleiner als das eingegebene Datum:

Code:
Datum = InputBox("Bitte Datum eingeben (TT.MM.JJ). Alle Einträge älter als dieses Datum werden archiviert.")
   If Not IsDate(Datum) Then
   MsgBox "Kein gültiges Datum!"
   Exit Sub
   End If
ThisWorkbook.Sheets("Mängel").Range("B4:O4").AutoFilter Field:=13, Criteria1:="<" & CDbl(Datum)

Als nächstes nehme ich mich dem Zeile löschen Problem an. Die von dir genannte Hilfsspalte habe ich bereits für ein Change-Ereignis.
Danke erstmal!
Antworten Top
#7
Code:
ThisWorkbook.Sheets("Mängel").Range("B5:O" & ActiveSheet.Cells(Rows.Count, 15).End(xlUp).Row).Select
Nachdem ich den Autofilter gesetzt habe möchte ich nur die gefilterten Zeilen markieren.
Also B5:B & x. Ich dachte mit dem gezeigten Code krieg ich das hin, aber er markiert einfach den Bereich B5:O4. Quasi in die falsche Richtung nach oben.
Wenn ich xlDown verwende, markiert er bis Zeile 4152. Och das ist so als würde ich dauernd gegen eine Wand laufen Sad

Kann mir bitte jemand unter die Arme greifen?
Antworten Top
#8
Hallo,

mit Autofilter geht das sehr elegant.

Mit Datumsformaten gibt es oft Probleme, du musst in der Datei testen .

Im Prinzip geht es so: Datum in Spalte A, header in Zeile 1

Code:
with cells(1).currentRegion
   .Autofilter 1, "<" & Datum
   .delete
end with

Das "Datum" muss das richtige Format haben.

mfg
[-] Folgende(r) 1 Nutzer sagt Danke an Fennek für diesen Beitrag:
  • kliffi01
Antworten Top
#9
Hallo,

Nochmals Danke für eure Mühen.
Das Ergebnis der Datumsabfrage sieht nun so aus:
Code:
' Abfrage nach Datum, alle Einträge vorher werden archiviert
Datum = InputBox("Bitte Datum eingeben (TT.MM.JJ). Alle Einträge älter als dieses Datum werden archiviert.")
   If Datum = "" Or False Or IsNumeric(Datum) = False Then
   Exit Sub
   End If
dDatum = CDate(Datum)
   If Not IsDate(dDatum) Then
   MsgBox "Kein gültiges Datum!"
   Exit Sub
   End If
Abbrechen oder "X" der Inputbox verursachen so keinen Fehler.

Und den Autofilter habe ich so gemacht:
Code:
' Setzt den Autofilter auf alle "erledigt am" vor dem genannten Datum
ThisWorkbook.Sheets("Mängel").Range("B4:O4").AutoFilter Field:=13, Criteria1:="<" & CDbl(dDatum)

Beides funktioniert wie es soll!

Grüße
Martin
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste