suche Zeichen - lösche darunter/darüber

Forumthread: suche Zeichen - lösche darunter/darüber

21.07.2021 08:53:15

Vanessa

Hallo liebe Excelfans,
ich möchte mir mal wieder die Arbeit etwas erleichtern und möchte
ein Makro erstellen welches in einem Excelblatt nach genau dem Zellwert SA und SO und FE sucht.
Sobald gefunden soll er den Inhalt der Zelle löschen, außerdem den Zellinhalt der darüber liegenden Zelle
und darunter weitere 24 Zellen.
z.B.:
gefunden wird in Zelle M3 exakt der Wert SA
Dann lösche M2 bis M27
dannach weiter suchen nach SA/SO/FE
Habt ihr eine Lösung für mich wie das funktionieren könnte?
LG
Vanessa

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: suche Zeichen - lösche darunter/darüber

21.07.2021 09:29:19

MCO

Hallo Vanessa!
Sa(mstag), So(nntag) und (FE)iertag sollten so gelöscht werden.
Ich hab im Code zur Probe noch ne Bremse reingehauen, wirst du sehen.
Viel Erfolg!


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

Gruß, MCO

AW: suche Zeichen - lösche darunter/darüber

21.07.2021 11:55:24

Vanessa

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

AW: suche Zeichen - lösche darunter/darüber

21.07.2021 12:21:24

MCO

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

AW: suche Zeichen - lösche darunter/darüber

21.07.2021 13:21:23

Vanessa

Hallo und besten Dank!
ich habe lösch_ber.ClearContents mit Selection.ClearContents ersetzt,
dann hat es genau das gemacht was ich wollte.
SUPER!!!
Tausend Dank!
Vanessa

und wieso weiter offen?...owT

21.07.2021 13:28:26

Oberschlumpf

AW: suche Zeichen - lösche darunter/darüber

21.07.2021 12:44:15

Daniel

Hi
Probiers mal so:
Voraussetzung ist, dass die Werte Konstanten sind, keine Formeln.


Cells.Replace "SA", true, xlwhole
Cells.Replace "SO", true, xlwhole
Cells.Replace "FE", true, xlwhole
Cells.Specialcells(xlcelltypeconstants, 4).Offset(-1, 0).resize(26, 1).clearcontents

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

suche Zeichen - lösche darunter/darüber

Forumthread: suche Zeichen - lösche darunter/darüber

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread