Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1620to1624
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

vba weiter suchen

vba weiter suchen
09.05.2018 21:16:52
Simal
Hallo Zusammen,
ich hoffe ihr könnt mir weiterhelfen....
Habe Folgenden Code eingegeben :
Sub leer_weg()
Cells.Find("Prüfling").Activate
ActiveCell.Offset(1, 0).Select
If ActiveCell = "" Then
ActiveCell.Offset(-1, 0).Select
Range("E" & ActiveCell.Row & ":M" & ActiveCell.Row).Select
Selection.Delete
Range("F9").Select
End If
End Sub

Dieser funktioniert auch, aber nur einmal. Er soll danach weiter suchen und das gleiche wieder ausführen, bis er nichts mehr findet. Dann einfach Exit Sub.
Auf Deutsch was dieses Makro tut:
Suche das Wort Prüfling,
wenn gefunden dann geh in die Zelle darunter
wenn diese Leer ist dann geh wieder zur Zelle Prüfling
markiere E bis M und lösche das
Wenn Zelle unter Prüfling ist nicht leer dann such weiter
Ich weiß das geht bestimmt allgemein viel besser :(
Liebe Grüße, Simal

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: vba weiter suchen
09.05.2018 21:44:58
onur
Wenn du unter "MSDN Find." googelst, findest du auch, wie man "Find." korrekt benutzt.
https://msdn.microsoft.com/de-de/vba/excel-vba/articles/range-find-method-excel
AW: vba weiter suchen
09.05.2018 21:48:12
Simal
Hab ich schon probiert, bin hier auch nicht weiter gekommen..... :(
AW: vba weiter suchen
09.05.2018 22:03:13
Robert
Hallo Simal,
versuche es mal so:
Sub leer_weg()
Dim cl As Range, firstAddress As String
With ActiveSheet.Cells
Set cl = .Find("Prüfling", LookIn:=xlValues)
If Not cl Is Nothing Then
firstAddress = cl.Address
Do
If cl.Offset(1, 0) = "" Then Range("E" & cl.Row & ":M" & cl.Row).ClearContents
Set cl = .FindNext(cl)
Loop While Not cl Is Nothing And cl.Address  firstAddress
End If
End With
End Sub

Gruß
Robert
Anzeige
AW: vba weiter suchen
09.05.2018 22:13:45
Simal
Vielen lieben Dank Robert!
Ich habe jetzt ClearContents mit Delete ersetzt weil nicht nur der Inhalt gelöscht werden soll.
Jetzt kommt eine Fehlermeldung. Könntest du mir nochmal helfen?
Lieben Dank!!!!
AW: vba weiter suchen
09.05.2018 22:45:49
onur
Es heisst nicht ".Delete" sondern ".Clear".
AW: vba weiter suchen
09.05.2018 22:47:26
Robert
Hallo Simal,
wieso bei Dir dann ein Fehler kommt, kann ich nicht sagen. Bei mir funktioniert auch die Zeile
If cl.Offset(1, 0) = "" Then Range("E" & cl.Row & ":M" & cl.Row).Delete

Dass es mit der Delete-Anweisung bei mir funktioniert, könnte natürlich an der Version liegen. Ich arbeite hier noch mit Excel2007 und Du mit 2013. Vielleicht gibt es da ja Unterschiede. Welche Fehlermeldung erhälst Du denn?
Bist Du aber sicher, dass Du Delete verwenden willst?
Delete löscht die Zellen. Je nachdem, wie man den Befehl anwendet, rutschen entweder die Zellen rechts von den gelöschten nach links oder die Zellen unter den gelöschten nach oben. Steuern kann man das über den Parameter Shift:= (xlUp für Zellen nach oben verschieben, xlToLeft für Zellen nach links verschieben).
Wenn z. B. die Zellen E4:M4 mit der Delete-Anweisung gelöscht werden, rutschen alle Zellen in den Spalten E bis M unterhalb der Zeile 4 eine Zeile hoch weil der zu löschende Bereich breiter als hoch ist. D. h. die Zelle E5 ist neu E4, F5 ist neu E4 usw.
Wenn Du statt ClearContent die Funktion Clear verwendest, wird neben dem Wert auch die Formatierung der Zelle gelöscht.
Gruß
Robert
Anzeige
AW: vba weiter suchen
09.05.2018 22:57:47
Simal
bei Delete kommt
Laufzeitfehler 1004
Die FindNext-Eigenschaft des Range-Objektes kann nicht zugeordnet werden.
Ja genau richtig, er soll alles löschen und hoch rücken
AW: vba weiter löschen
09.05.2018 22:58:58
Gerd
Moin
Sub leer_weg()
Dim cl As Range, firstAddress As String, X As Range
With ActiveSheet.Cells
Set cl = .Find("Prüfling", LookIn:=xlValues)
If Not cl Is Nothing Then
firstAddress = cl.Address
Do
If cl.Offset(1, 0) = "" Then
If X Is Nothing Then
Set X = .Parent.Cells(cl.Row, 5).Resize(1, 9)
Else
Set X = Union(X, .Parent.Cells(cl.Row, 5), Resize(1, 9))t
End If
End If
Set cl = .FindNext(cl)
Loop Until cl.Address = firstAddress
If Not X Is Nothing Then
X.Delete
Set X = Nothing
Set cl = Nothing
End If
End If
End With
End Sub

Gruß Gerd
Anzeige
AW: vba weiter löschen
09.05.2018 23:07:59
Simal
Lieben Dank, jetzt kommt Fehler beim Kompilieren:
Syntaxfehler
Hmmm :(
AW: ups
10.05.2018 08:32:10
Gerd

Sub leer_weg()
Dim cl As Range, firstAddress As String, X As Range
With ActiveSheet.Cells
Set cl = .Find("Prüfling", LookIn:=xlValues)
If Not cl Is Nothing Then
firstAddress = cl.Address
Do
If cl.Offset(1, 0) = "" Then
If X Is Nothing Then
Set X = .Parent.Cells(cl.Row, 5).Resize(1, 9)
Else
Set X = Union(X, .Parent.Cells(cl.Row, 5).Resize(1, 9))
End If
End If
Set cl = .FindNext(cl)
Loop Until cl.Address = firstAddress
If Not X Is Nothing Then
X.Delete
Set X = Nothing
Set cl = Nothing
End If
End If
End With
End Sub

Anzeige
AW: ups
10.05.2018 14:59:44
Simal
Vielen lieben Dank Gerd das ist PERFEKT!
Du hast mir wirklich sehr weitergeholfen!!!!
Wünsch euch allen einen schönen Feiertag!
Liebe Grüße, Simal

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige