AW: Zellen löschen
21.11.2009 14:59:44
Daniel
Hi
probiers mal damit:
Sub ZeilenLöschen()
With ActiveSheet.UsedRange
With .Columns(.Columns.Count).Offset(0, 1)
.FormulaR1C1 = "=if(FolgePrüfen(RC?),"""",Row())"
'--für ? die Spaltennummer der Hilfsspalte eintragen
.Formula = .Value
.EntireRow.Sort Key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlNo
If .Application.CountBlank(.Cells) Then _
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
.EntireColumn.Delete
End With
End With
End Sub
Public Function FolgePrüfen(Zeichenfolge As String) As Variant
Dim Ziffer() As String
Dim i As Long
Dim chk As Long
Ziffer = Split(Zeichenfolge, ";")
FolgePrüfen = False
For i = 1 To UBound(Ziffer)
Select Case Ziffer(i) - Ziffer(i - 1)
Case 1
chk = chk + 1
If chk = 2 Then
FolgePrüfen = True
Exit Function
End If
Case Else
chk = 0
End Select
Next
End Function
Gruß, Daniel