AW: Doppelte Löschen Erweitert
04.07.2007 09:18:36
Chaos
Servus Thomas,
ich hab mich mal an deine Vorgabe gehalten und das makro komplett anders aufgebaut.
Sub neu()
Dim m As String
Dim z1 As Range, z As Range, z2 As Range
On Error GoTo fehler
m = ActiveCell.Address
Range(Selection, Selection.End(xlDown)).Select
For Each z1 In Selection
If z1.Value = "Bier- u.s.w." Then
z1.FormulaR1C1 = "Bierverzehrinm3"
End If
Next z1
For Each z2 In Selection
If z2.Value = "Bierverzehrinm3" Then
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "#,##0.0"
End If
Next z2
For Each z In Selection
If z.Value = z(4, 1).Value And z.Value = "Bierverzehrinm3" Then
Range(z(2, 1), z(2, 3)).Select
Range(Selection, Selection.End(xlDown)).ClearContents
End If
Next z
Range(m).Select
fehler:
Range(m).Select
Exit Sub
End Sub
das makro ändert deine Zellen (Name und Format), wenn vorhanden und löscht wenn der Wert sich in der dritten zeile darunter wiederholt alles ab der zeile darunter, einschließlich der nächsten 2 Spalten.
Wenn nichts da ist geht es wieder zur 1. Makierung (zelle) zurück.
Gruß
Chaos