Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 17:05:40
Zählen von Zeilen, in denen in bestimmten Bereich Daten sind
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
19.04.2024 15:39:42
Exceltabelle daten per combobox zu word Datei
19.04.2024 14:04:05
PDF per VBA ausgeben - Seitenskalierung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
800to804
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
800to804
800to804
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Suchtext löschen

Suchtext löschen
11.09.2006 10:21:43
Sven
Hallo Leute,
wie kann ich nach erfolgreicher Suche den Suchtext automatisch wieder löschen?

Sub Search()
Dim strSrch As String
Dim xFind
strSrch = Application.CommandBars("Apotheke").Controls(5).Text
If strSrch = "" Then Exit Sub
Set xFind = Cells.Find(What:=strSrch, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False)
If Not xFind Is Nothing Then
xFind.Offset(0, 8).Activate
(hier müsste doch der Löschvermerk hin, oder ?)
Else
MsgBox "Suchbegriff wurde nicht gefunden !"
End If
End Sub

Danke, Sven

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchtext löschen
11.09.2006 10:57:48
fcs
Hallo Sven,
wiederhole am Ende des Makros die Suche mit einem Leerstring. Ggf. statt xFind eine andere Variable verwenden. 

Sub Search()
Dim strSrch As String
Dim xFind
strSrch = Application.CommandBars("Apotheke").Controls(5).Text
If strSrch = "" Then Exit Sub
Set xFind = Cells.Find(What:=strSrch, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False)
If Not xFind Is Nothing Then
xFind.Offset(0, 8).Activate
Else
MsgBox "Suchbegriff wurde nicht gefunden !"
End If
Set xFind = Cells.Find(What:="", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False)
End Sub

Gruß
Franz
Anzeige
AW: Suchtext löschen
11.09.2006 11:04:37
Sven
Danke Franz, das lief so nicht, keine Veränderung. der alte Text steht nach wie vor oben drin.
Gruß Sven
AW: Suchtext löschen
11.09.2006 11:16:05
fcs
Hallo Sven,
wo ist "oben" ? In der von dir kreierten Menüleiste?
mein Vorschlag löscht den Suchstring im Dialogfenster "Suchen/Ersetzen"
Evtl. geht es so: 

Sub Search()
Dim strSrch As String
Dim xFind
strSrch = Application.CommandBars("Apotheke").Controls(5).Text
If strSrch = "" Then Exit Sub
Set xFind = Cells.Find(What:=strSrch, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False)
Application.CommandBars("Apotheke").Controls(5).Text = ""
If Not xFind Is Nothing Then
xFind.Offset(0, 8).Activate
Else
MsgBox "Suchbegriff wurde nicht gefunden !"
End If
End Sub

Gruß
Franz
Anzeige
AW: Suchtext löschen
11.09.2006 13:41:57
Sven
Danke Franz,
wenn du mir jetzt noch sagen kannst, wie ich nur am Zellanfang suchen kann ?
Gruß Sven
AW: Suchtext löschen
11.09.2006 14:59:49
fcs
Hallo Sven,
für Suche ab Zellenanfang muß du den Suchstring um ein "*" ergänzen und den Parameter LookAt auf xlWhole ändern. Schaut dann z.B. so aus: 

Sub Search()
Dim strSrch As String
Dim xFind
strSrch = Application.CommandBars("Apotheke").Controls(5).Text
If strSrch = "" Then Exit Sub
strSrch = strSrch & "*"
Set xFind = Cells.Find(What:=strSrch, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False)
Application.CommandBars("Apotheke").Controls(5).Text = ""
If Not xFind Is Nothing Then
xFind.Offset(0, 8).Activate
Else
MsgBox "Suchbegriff wurde nicht gefunden !"
End If
End Sub

Gruß
Franz
Anzeige
AW: Suchtext löschen
11.09.2006 16:30:00
Sven
perfekt, danke
ein Problem habe ich noch.
Wie in nachstehendem Code abgebildet, wird bei einen kleineren oder gleichen Wert in Spalte 9 eine Kopierfunktion gestartet. Wenn dieser Wert bereits vorhanden ist, soll er in der Tabelle "Bestellung" überschrieben werden.
Jetzt möchte ich es zusätzlich umkehren: wenn der Wert in Spalte 9 wieder größer ist und in der Tabelle "Bestellung" bereits vorhanden, dann soll diese Zeile wieder gelöscht werden.
Ich habe da schon mal etwas holflos rumgedoktort.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo ende
Sheets("Bestand").Unprotect Password:="Sommer12"
If Target.Column = 11 Then Cells(Target.Row, Target.Column - 2) = Cells(Target.Row, Target.Column - 2) + Target.Value 'Zugang
If Target.Column = 12 Then Cells(Target.Row, Target.Column - 3) = Cells(Target.Row, Target.Column - 3) - Target.Value 'Abgang
If Cells(Target.Row, 9) <= Cells(Target.Row, 10) Then
With Sheets("Bestellung")
Bestellnummer = Cells(Target.Row, 7)
Set c = .Columns(1).Find(What:=Bestellnummer, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
c(1, 5) = Cells(Target.Row, 8) - Cells(Target.Row, 9) 'wenn Bestellnummer bereits vorhanden, dann Wert überschreiben
Else
lz = .Cells(Rows.Count, 1).End(xlUp).Row + 1 ' Reihen jeweils um 1 erweitern
.Cells(lz, 1) = Cells(Target.Row, 7) 'kopiert Artikelnummer nach Bestellung in Spalte 1
.Cells(lz, 2) = Cells(Target.Row, 3) 'kopiert Warengruppe nach Bestellung in Spalte 2
.Cells(lz, 3) = Cells(Target.Row, 4) 'kopiert Artikelname nach Bestellung in Spalte 3
.Cells(lz, 4) = Cells(Target.Row, 5) 'kopiert Inhalt nach Bestellung in Spalte 4
.Cells(lz, 5) = Cells(Target.Row, 8) - Cells(Target.Row, 9) 'Differenz aus Soll-Ist in Spalte 5
End If
End With
End If
---hier ist mein Versuch ----
If Cells(Target.Row, 9) > Cells(Target.Row, 10) Then
With Sheets("Bestellung")
Bestellnummer = Cells(Target.Row, 7)
Set c = .Columns(1).Find(What:=Bestellnummer, LookIn:=xlValues, LookAt:=xlWhole)
If c Is Nothing Then
.Row.Delete (c)
End If
End With
End If
If Cells(Target.Row, 11) <> "" Then Cells(Target.Row, 11) = "" 'nach Zugang Zelle leeren
If Cells(Target.Row, 12) <> "" Then Cells(Target.Row, 12) = "" 'nach Abagng Zelle leeren
ende:
Sheets("Bestand").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Sommer12"
End Sub

Anzeige
AW: Suchtext löschen
11.09.2006 19:27:46
fcs
Hallo Sven,
so sollte es funktionieren. Ich hab zusätzlich die Variablen in der Dim-Anweisung deklariert. Macht das Erstellen des Codes etwas einfacher.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Bestellnummer, c As Range, lz As Long
On Error GoTo ende
Sheets("Bestand").Unprotect Password:="Sommer12"
If Target.Column = 11 Then Cells(Target.Row, Target.Column - 2) = Cells(Target.Row, Target.Column - 2) + Target.Value 'Zugang
If Target.Column = 12 Then Cells(Target.Row, Target.Column - 3) = Cells(Target.Row, Target.Column - 3) - Target.Value 'Abgang
If Cells(Target.Row, 9) <= Cells(Target.Row, 10) Then
With Sheets("Bestellung")
Bestellnummer = Cells(Target.Row, 7)
Set c = .Columns(1).Find(What:=Bestellnummer, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
c(1, 5) = Cells(Target.Row, 8) - Cells(Target.Row, 9) 'wenn Bestellnummer bereits vorhanden, dann Wert überschreiben
Else
lz = .Cells(Rows.Count, 1).End(xlUp).Row + 1 ' Reihen jeweils um 1 erweitern
.Cells(lz, 1) = Cells(Target.Row, 7) 'kopiert Artikelnummer nach Bestellung in Spalte 1
.Cells(lz, 2) = Cells(Target.Row, 3) 'kopiert Warengruppe nach Bestellung in Spalte 2
.Cells(lz, 3) = Cells(Target.Row, 4) 'kopiert Artikelname nach Bestellung in Spalte 3
.Cells(lz, 4) = Cells(Target.Row, 5) 'kopiert Inhalt nach Bestellung in Spalte 4
.Cells(lz, 5) = Cells(Target.Row, 8) - Cells(Target.Row, 9) 'Differenz aus Soll-Ist in Spalte 5
End If
End With
Else
With Sheets("Bestellung")
Bestellnummer = Cells(Target.Row, 7)
Set c = .Columns(1).Find(What:=Bestellnummer, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
.Rows(c.Row).Delete shift:=xlUp
End If
End With
End If
If Cells(Target.Row, 11) <> "" Then Cells(Target.Row, 11) = "" 'nach Zugang Zelle leeren
If Cells(Target.Row, 12) <> "" Then Cells(Target.Row, 12) = "" 'nach Abagng Zelle leeren
ende:
Sheets("Bestand").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Sommer12"
End Sub

Gruss
Franz
Anzeige
AW: Suchtext löschen
12.09.2006 09:21:31
Sven
Danke, danke, danke
Ich hoffe nur, ich werde auch mal so gut in VBA
AW: Suchtext löschen
12.09.2006 11:20:29
Sven
Hallo Franz,
die varangegangene Funktion funktioniert prima, allerdings habe ich jetz bei einer anderen Funktion ein Problem. Bei nachstehendem Code löse ich die Bestellung per Klick aus. In diesem Fall wird in der Tabelle "Bestand" der IST-Wert auf den SOLL-Wert gesetzt und in ein anders Feld kommt der Text "aktiv". Allerdings scheint der Code sich mit dem anderen Code nicht mehr zu vertragen. Er führt nur 1 - 2 Durchläufe aus und bleibt dann hängen, es muss wohl an dem Entfernen der Zeilen in der Tabelle "Bestellungen" liegen.
Kannst du da noch mal helfen?
'bestellung auslösen

Sub Schaltfläche1_BeiKlick()
With Sheets("Bestand")
For z = 13 To Cells(Rows.Count, 1).End(xlUp).Row
Bestellnummer = Cells(z, 1)
Set c = .Cells.Find(What:=Bestellnummer, LookIn:=xlValues, LookAt:=xlWhole)
Sheets("Bestand").Unprotect Password:="Sommer12"
If Not c Is Nothing Then c(1, 3) = c(1, 2) ': c(1, 7) = "aktiv"
Next z
Sheets("Bestellung").Unprotect Password:="Sommer12"
Range("a13:e130").Select
Selection.Sort Key1:=Range("c13"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("a13").Select
Sheets("Bestellung").PrintOut Copies:=1, Collate:=True
Sheets("Bestellung").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Sommer12"
End With
Sheets("Bestand").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Sommer12"
End Sub

Anzeige
AW: Suchtext löschen
12.09.2006 20:31:22
fcs
Hallo Sven,
ohne Kenntnis der Datei/Tabellen ist es schwierig zu sagen, warum der Code abbricht. Welche Fehlermeldung kommt denn?
Su solltest allerdings die Unprotect-Zeile vor die For-Zeile setzen. Damit der Wert "aktiv" eingetragen wird muss du auch das Hochkomma in der entsprechenden Zeile entfernen!
Ich glaube aber nicht, dass der Abbruch mit den Aktivitäten des anderen Makros zusammenhängt. Ansonsten im Makro an der For-Anweisung einen Haltepunkt setzen und dann das Makro starten und mit Tatse F8 schrittweise abarbeiten, dann siehst wann das Makro aussteigt und wieviele For-Schleifen abgearbeitet werden. 

Sub Schaltfläche1_BeiKlick()
With Sheets("Bestand")
.Unprotect Password:="Sommer12"
For z = 13 To Cells(Rows.Count, 1).End(xlUp).Row
Bestellnummer = Cells(z, 1)
Set c = .Cells.Find(What:=Bestellnummer, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then c(1, 3) = c(1, 2): c(1, 7) = "aktiv"
Next z
Sheets("Bestellung").Unprotect Password:="Sommer12"
Range("a13:e130").Select
Selection.Sort Key1:=Range("c13"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("a13").Select
Sheets("Bestellung").PrintOut Copies:=1, Collate:=True
Sheets("Bestellung").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Sommer12"
End With
Sheets("Bestand").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Sommer12"
End Sub

Gruss
Franz
Anzeige
AW: Suchtext löschen
13.09.2006 08:14:54
Sven
Hallo Franz, wir haben das Problem gelöst
aktive Prozesse werden einfach angehalten, solange dieses Danke für die viele Hilfe
Gruß Sven
'bestellung auslösen

Sub Schaltfläche1_BeiKlick()
Application.EnableEvents = False   <---
With Sheets("Bestand")
.Unprotect Password:="Sommer12"
For z = 13 To Cells(Rows.Count, 1).End(xlUp).Row
Bestellnummer = Cells(z, 1)
Set c = .Cells.Find(What:=Bestellnummer, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then c(1, 3) = c(1, 2): c(1, 7) = "aktiv"
Next z
Sheets("Bestellung").Unprotect Password:="Sommer12"
Range("a13:e130").Select
Selection.Sort Key1:=Range("c13"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("a13").Select
Sheets("Bestellung").PrintOut Copies:=1, Collate:=True
Sheets("Bestellung").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Sommer12"
End With
Sheets("Bestand").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Sommer12"
Application.EnableEvents = True
End Sub

Anzeige
AW: Suchtext löschen
12.09.2006 11:23:41
Sven
Nachtrag:
Im Prinzip darf das Löschen der Zeilen nicht beim Klickbefehl passieren, da er sonst ein leeres Blatt druckt (weil ja die zelle vorher schon wieder entfernt wurde)
Gruß Sven

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige