AW: Alle Zeilen ohne Zahl löschen
29.11.2014 18:55:58
Tino
Hallo,
kannst mal diesen Code testen.
Was ich es nicht weis, sind es echte Zahlen oder nur Text!
Sub Start()
Dim rngHilfe As Range
With Tabelle1 'Tabelle anpassen
'ab A2, in Zeile 1 ist Überschrift (evtl. anpassen)
Set rngHilfe = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
If rngHilfe.Rows(1).Row < 2 Then Exit Sub 'keine Daten
Set rngHilfe = rngHilfe.EntireRow.Columns(.Columns.Count)
End With
Events_ False
On Error GoTo ErrorHandler:
With Application.WorksheetFunction
'Daten löschen die > 9999
rngHilfe.FormulaR1C1 = "=IF(AND(RC1>9999,RC1<10^15),TRUE,ROW())"
If .CountIf(rngHilfe, True) > 0 Then
rngHilfe.EntireRow.Sort Key1:=rngHilfe.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
rngHilfe.SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
End If
rngHilfe.Clear
'doppelte Datenb löschen
rngHilfe.FormulaR1C1 = "=IF(COUNTIF(R" & rngHilfe.Rows(1).Row & "C1:RC1,RC1)>1,TRUE,ROW())"
If .CountIf(rngHilfe, True) > 0 Then
rngHilfe.EntireRow.Sort Key1:=rngHilfe.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
rngHilfe.SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
End If
rngHilfe.Clear
rngHilfe.EntireColumn.Delete
End With
ErrorHandler:
Events_ True
End Sub
Sub Events_(booSchalter As Boolean)
With Application
.ScreenUpdating = booSchalter
.EnableEvents = booSchalter
.DisplayAlerts = booSchalter
.Calculation = IIf(booSchalter, xlCalculationAutomatic, xlCalculationManual)
End With
End Sub
Gruß Tino