29.08.2018, 20:34
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
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