Zeilen löschen
24.11.2016 15:16:27
Berndt
ich habe eine Frage bzgl. meines Makros.
Code:
Private Sub CommandButton2_Click()
' neue Zeile einfügen für Aufgabe oder Problem
Dim EZ As Double
Dim Ab As Double
Dim WoEinf As String
Application.ScreenUpdating = False
'ActiveSheet.Unprotect
WoEinf = InputBox("(A)ufgabe" & vbLf & "(P)roblem", "Wo möchten Sie eine neue Zeile hinzufü _
gen?", "A")
Select Case UCase(WoEinf)
Case "A"
EZ = UF_neueZeile(8, True)
Range("D" & EZ & ":H" & EZ).FormulaR1C1 = "=SUM(R8C:R[-1]C)"
Cells(EZ - 1, 2).Select
Case "P"
'Text: Problemspeicher nach unten suchen
EZ = Cells(8, 2).End(xlDown).End(xlDown).Row
If Trim(Cells(EZ, 2)) = "Problemspeicher" Then
EZ = UF_neueZeile(EZ + 1, True)
Else: MsgBox "Kann Text: -Problemspeicher- nicht finden"
End If
Case Else
Exit Sub
End Select
'ActiveSheet.Protect , UserInterfaceOnly:=True
Application.ScreenUpdating = True
End Sub
Function UF_neueZeile(Ab, Ja As Boolean)
Dim EZ, BZ As Double
EZ = Evaluate("=MIN(IF(B" & Ab & ":B65536="""",ROW(" & Ab & ":65536)))")
If Ja Then
Rows(EZ).Insert Shift:=xlDown
Rows(EZ - 1).Copy
Rows(EZ).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
EZ = EZ + 1
End If
UF_neueZeile = EZ
End Function
Problem ist, das als Formatvorlage immer die obere Zeile genommen wird.
Wenn nämlich noch keine Aufgabenzeile oder Problemzeile vorhanden ist, dann wird sie Spaltenkopfformatierung übernommen.
Ich bräuchte so eine Art Prüfzeile. die Prüft, ob schon eine zumindest Formatierte Zeile eingefügt wurde (kann ja noch leer sein von mir aus)
Ist dies umsetzbar?
VG Berndt