Ich möchte alle Zeilen einer sehr langen Liste löschen lassen, wenn sie in der Spalte A nicht den
gleichen Begriff aufweisen, wie in A1 steht.
Vielen Dank.
Gruss
Frédéric
Sub test()
Dim loRow As Long
For loRow = Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Range("A" & loRow).Value Range("A1").Value Then
Rows(loRow & ":" & loRow).Delete Shift:=xlUp
End If
Next
End Sub
Sucht in den Zeilen 2 bis letzte, benutzte Zeile in Spalte A und löscht JEDE Zeile, dessen Wert in Spalte A NICHT mit Wert in Zelle A1 übereinstimmt.Public Sub del_lines()
dim i as long
dim szCompare as string
szCompare = sheets(1).Cells(1,1).Value
for i = 2 to 65536 ' über alle Zeilen
' Abbruchbedingung
if sheets(1).cells(i,1).Value = "" then exit for
if sheets(1).cells(i,1).Value szCompare then
sheets(1).Rows(i).delete
endif
next i
End Sub
best wishesSub Loeschen_Mit_Formel()
Dim oSH As Worksheet, iCalc As Integer
Set oSH = Sheets("Tabelle1") 'Tabelle anpassen
With Application
iCalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
With oSH.UsedRange
With .Columns(.Columns.Count).Offset(0, 1)
.Formula = "=IF(RC1R1C1,TRUE,ROW())" 'entsprechende Formel
oSH.UsedRange.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
On Error Resume Next
.SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
.EntireColumn.Delete
On Error GoTo 0
End With
End With
.ScreenUpdating = True
.Calculation = iCalc
End With
End Sub
Sub Loeschen_Mit_Formel()
Dim oSH As Worksheet, iCalc As Integer
Dim i As Integer
With Application
iCalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
'Schleife ab den 9. Tabellenblatt
For i = 9 To Worksheets.Count
Set oSH = Worksheets(i) 'Tabelle anpassen
With oSH.UsedRange
With .Columns(.Columns.Count).Offset(0, 1)
.Formula = "=IF(RC1R1C1,TRUE,ROW())" 'entsprechende Formel
oSH.UsedRange.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
On Error Resume Next
.SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
.EntireColumn.Delete
On Error GoTo 0
End With
End With
Next i
.ScreenUpdating = True
.Calculation = iCalc
End With
End Sub
Gruß Tino