Excel hängt sich auf: Lösche wenn len(next) größer
10.03.2016 09:53:30
Alex
in einer Gliederung kann ich Punkte löschen, wenn ein Punkt Untergliederungspunkte hat sollen diese auch automatisch gelöscht werden.
1.1
1.2 //gelöscht
1.2.1 //soll automatisch gelöscht werden
1.3
Hatte mir einen Code überlegt, der funktioniert auch, aber Excel hängt sich leider auf...Keine Ahnung warum
Über eine Listbox markiere ich mein zu löschendes Element (Spalte B),
Dann springe ich eine Spalte nach links, schaue die len(Ausgangszelle)in Spalte A an, dann soll er solange jede Zeile löschen, bis die nächste Zelle die gleiche Länge hat wie die ausgangszelle.
Public Auswahllistbox1 As String 'im Modul erstellt
Public Kategorie As Worksheet 'im Modul erstellt
Private Sub CommandButton2_Click() 'löschen
Dim rng As Range
Dim strfrage As String
Dim lngZeile As Long
Dim lngspalte As Long
Dim ausgangsZelle As String
Dim nächsteZelle As String
strfrage = " - wirklich entfernen?"
With ListBox1
If .Selected(.ListIndex) = True Then
If MsgBox( _
prompt:="Wollen Sie den Eintrag - " & Auswahllistbox1 & strfrage, _
Buttons:=vbYesNo + vbQuestion _
) = vbYes Then
Unload Me
Set rng = Sheets(Kategorie).Cells.Find(What:=Auswahllistbox1, after:=ActiveCell, LookIn:= _
xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
lngspalte = rng.Column 'funktion
lngZeile = rng.Row 'funktion
lngsplate = lngspalte - 1 'funktion
ausgangsZelle = Cells(lngZeile, lngspalte).Value 'funktion
Do 'funktion
Cells(lngZeile, 1).EntireRow.Delete 'funktion
lngezeile = lngZeile + 1 'funktion
nächsteZelle = Cells(lngZeile, 2).Value 'funktion
Loop Until Len(ausgangsZelle) = Len(nächsteZelle) 'funktion
End If
End If
End With
End Sub