AW: Zeilen löschen, wenn "Wert"
29.04.2009 12:14:29
Tino
Hallo,
teste mal diesen Code.
Es werden zwei Hilfsspalten am Ende der Tabelle verwendet,
diese werden am Schluss wider gelöscht.
Tabellenname musst Du noch anpassen.
Option Explicit
Sub LoescheDaten_Mit_Formel_Hilfe()
Dim Bereich As Range, SortBereich As Range, GesamtBereich As Range
Dim iCalc As Integer
With Application
iCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
With Sheets("Tabelle1") 'Tabellennamen anpassen
Set Bereich = .Range("N2", .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 14))
If Intersect(Bereich, .Rows(1)) Is Nothing Then
Set Bereich = Bereich.Offset(0, .Columns.Count - Bereich.Column)
Set SortBereich = Bereich.Offset(0, -1)
Set GesamtBereich = .Range("A2", .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Columns.Count))
SortBereich.FormulaR1C1 = "=ROW()"
Bereich.FormulaR1C1 = "=IF(RC14=""Wert"",0,"""")"
If Application.WorksheetFunction.CountIf(Bereich, 0) > 0 Then
GesamtBereich.Sort Bereich(1, 1), xlAscending, , , , , , xlNo
Bereich.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
GesamtBereich.Sort SortBereich(1, 1), xlAscending, , , , , , xlNo
End If
'Lösche die Formelspalte am ende der Tabelle
.Columns(.Columns.Count).Delete
.Columns(.Columns.Count - 1).Delete
End If
End With
.Calculation = iCalc
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Gruß Tino