suche Zeichen - lösche darunter/darüber

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Bereiche_löschen() Dim ber As Range, neu_ber As Range Dim suchbegr_arr As Variant Dim i As Long, zellen_darüber As Long, Zellen_darunter As Long zellen_darüber = 1 Zellen_darunter = 24 suchbegr_arr = Array("SA", "SO", "FE") For i = 0 To UBound(suchbegr_arr) Set ber = Cells.Find(suchbegr_arr(i), lookat:=xlWhole) If Not ber Is Nothing Then first_address = ber.Address Do Set neu_ber = Range(ber.Offset(-zellen_darüber, 0), ber.Offset(Zellen_darunter, 0)) 'ber.Interior.ColorIndex = 7 ber.Offset(1, 0).Value = neu_ber.Address(0, 0) & Chr(10) & " würde gelöscht" 'neu_ber.ClearContents 'Bereich löschen Set ber = Cells.FindNext(ber) Loop While Not ber Is Nothing And ber.Address first_address End If Next i MsgBox "fertig" End Sub

Hallo MCO,
ich bekomme es einfach nicht auf die Reihe.
Das was gelöscht werden soll wird korrekt in die Zelle eingetragen.
Jetzt dachte ich nehme die Zeile
ber.Offset(1, 0).Value = neu_ber.Address(0, 0) & Chr(10) & " würde gelöscht"
raus, aber da passiert ausser Mdie Info "fertig" nichts.
Wenn ich es so habe:
If Not ber Is Nothing Then
first_address = ber.Address
Do
Set neu_ber = Range(ber.Offset(-zellen_darüber, 0), ber.Offset(Zellen_darunter, 0))
' ber.Interior.ColorIndex = 7
'ber.Offset(1, 0).Value = neu_ber.Address(0, 0) & Chr(10) & " würde gelöscht"
neu_ber.ClearContents 'Bereich löschen
Set ber = Cells.FindNext(ber)
Loop While Not ber Is Nothing And ber.Address first_address
End If
Dann macht er zwar für einen Suchbegriff die Löschung aber bringt ein Debuggen in der Zeile Loop.....
Was ist mein Problem?
Viele Grüße
Vanessa

hallo Vanessa!
Da war ich wohl mit dem löschen zu schnell: was gelöscht ist, kann in der Schleife nicht mehr berücksichtig werdne, daher der Fehler.
Jetzt leg ich erst die Bereiche fest und lösch sie am Ende:


Sub Bereiche_löschen()
Dim ber As Range, neu_ber As Range, lösch_ber As Range
Dim suchbegr_arr  As Variant
Dim i As Long, zellen_darüber As Long, Zellen_darunter As Long
zellen_darüber = 1
Zellen_darunter = 24
suchbegr_arr = Array("SA", "SO", "FE")
Set lösch_ber = Cells(ActiveSheet.UsedRange.Rows.Count, "A")
For i = 0 To UBound(suchbegr_arr)
Set ber = Cells.Find(suchbegr_arr(i), lookat:=xlWhole)
If Not ber Is Nothing Then
first_address = ber.Address
Do
Set neu_ber = Range(ber.Offset(-zellen_darüber, 0), ber.Offset(Zellen_darunter, 0))
Set lösch_ber = Application.Union(lösch_ber, neu_ber)
'ber.Offset(1, 0).Value = neu_ber.Address(0, 0) & Chr(10) & " würde gelöscht"
Set ber = Cells.FindNext(ber)
Loop While Not ber Is Nothing And ber.Address  first_address
End If
Next i
lösch_ber.Select 'überflüssig
lösch_ber.ClearContents
MsgBox "Bereich wurde gelöscht"
End Sub

Gruß, MCO

Beliebteste Forumthreads (12 Monate)

suche Zeichen - lösche darunter/darüber

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread