Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
736to740
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
736to740
736to740
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Suchen markieren löschen

Suchen markieren löschen
22.02.2006 10:05:52
Volker
Guten Morgen zusammen,
ich suche in meiner Arbeitsmappe mittels untenstehendem Code vorkommende Datensätze. Funktioniert auch.
Ich möchte -da jeder Datensatz nur einmal vorkommen darf- die Zeile in der er steht teilweise löschen. (Spalte A - E) weiter darf der Löschvorgang nicht gehen,
da sich an diesen Bereich anschließend Formeln befinden.

Sub MultiSeek()
Dim wks As Worksheet
Dim Rng As Range
Dim sAddress As String, sFind As String
sFind = InputBox("Bitte Suchbegriff eingeben:")
For Each wks In Worksheets
Set Rng = wks.Cells.Find( _
What:=sFind, _
LookAt:=xlWhole, _
LookIn:=xlFormulas)
If Not Rng Is Nothing Then
sAddress = Rng.Address
MsgBox "Lagerort " & wks.Name & " " & Rng.Address(0, 0)
Do
Application.Goto Rng, True
If MsgBox( _
prompt:="Weiter", _
Buttons:=vbYesNo + vbQuestion _
) = vbNo Then Exit Sub
Set Rng = Cells.FindNext(after:=ActiveCell)
If Rng.Address = sAddress Then Exit Do
Loop
End If
Next wks
MsgBox prompt:="Keine neue Fundstelle!"
End Sub

Was mus ich an dem Code verändern, damit dies möglich wird ?
Kann mir jemand helfen?
Danke Gruß Volker

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

Betreff
Datum
Anwender
Anzeige
AW: Suchen markieren löschen
22.02.2006 11:13:45
Luschi
Hallo Volker,
so geht's:
Sub MultiSeek()
Dim wks As Worksheet
Dim Rng As Range
Dim sAddress As String, sFind As String
sFind = InputBox("Bitte Suchbegriff eingeben:")
For Each wks In Worksheets
Set Rng = wks.Cells.Find( _
What:=sFind, _
LookAt:=xlWhole, _
LookIn:=xlFormulas)
If Not Rng Is Nothing Then
sAddress = Rng.Address
MsgBox "Lagerort " & wks.Name & " " & Rng.Address(0, 0)
Do
Application.Goto Rng, True
If MsgBox( _
prompt:="Weiter", _
Buttons:=vbYesNo + vbQuestion _
) = vbNo Then
Exit Do
'hier nicht Exit Sub, da noch die Objektvariablen
'deaktiviert werden sollen (auf Nothing stellen)
End If
Set Rng = Cells.FindNext(after:=ActiveCell)
If Rng.Address <> sAddress Then
'Rng.Row ergibt die aktive Zeile im Worksheet wks
wks.Range("A" & Rng.Row & ":E" & Rng.Row).Value = ""
Else
Exit Do
End If
Loop
End If
Next wks
Set wks = Nothing
Set Rng = Nothing
MsgBox prompt:="Keine neue Fundstelle!"
End Sub
Gruß von Luschi
aus klein-Paris
Anzeige
AW: Suchen markieren löschen
22.02.2006 12:13:59
Volker
Hallo Luschi,
danke für Deine Hilfe.
Ein kleines Problem ist trotzdem noch da.
Wenn im Rahmen des Codes ein Wert gefunden bzw. Gelöscht wurde, soll der Code beendet werden. Ich muß mich momentan durch alle Tabellenblätter klicken um den Code zubeenden.
Eventuell noch ein Tip?
Danke Gruß Volker
AW: Suchen markieren löschen
22.02.2006 12:42:29
Luschi
Hallo Volker,

dann so:
If Rng.Address <> sAddress Then
'Rng.Row ergibt die aktive Zeile im Worksheet wks
wks.Range("A" & Rng.Row & ":E" & Rng.Row).Value = ""
End If
Exit Do
Gruß von luschi
aus klein-Paris
AW: Suchen markieren löschen
22.02.2006 13:07:45
Volker
Hallo Luschi,
mit dem zweiten Ansatz funktioniert es soweit. Lediglich das Löschen der betreffenden Zeile
klappt nicht. Ich verstehe den Kommentar "Auf Nothing stellen" nicht.
Bitte wirf mal einen Blick auf den veränderten Code, habe ich dort irgendwo einen Fehler gemacht?

Sub MultiSeek()
Dim wks As Worksheet
Dim Rng As Range
Dim sAddress As String, sFind As String
sFind = InputBox("Bitte Suchbegriff eingeben:")
For Each wks In Worksheets
Set Rng = wks.Cells.Find( _
What:=sFind, _
LookAt:=xlWhole, _
LookIn:=xlFormulas)
If Not Rng Is Nothing Then
sAddress = Rng.Address
MsgBox "Lagerort " & wks.Name & " " & Rng.Address(0, 0)
Do
Application.Goto Rng, True
If MsgBox( _
prompt:="Weiter", _
Buttons:=vbYesNo + vbQuestion _
) = vbNo Then
Exit Do
'hier nicht Exit Sub, da noch die Objektvariablen
'deaktiviert werden sollen (auf Nothing stellen)
End If
Set Rng = Cells.FindNext(after:=ActiveCell)
If Rng.Address <> sAddress Then
'Rng.Row ergibt die aktive Zeile im Worksheet wks
wks.Range("A" & Rng.Row & ":E" & Rng.Row).Value = ""
End If
Exit Do
Loop
End If
Next wks
Set wks = Nothing
Set Rng = Nothing
MsgBox prompt:="Keine neue Fundstelle!"
End Sub

Danke Gruß Volker
Anzeige
AW: Suchen markieren löschen
22.02.2006 15:40:37
Luschi
Hallo Volker,
jede Objekt-Variable, also Variablen, die mit dem "Set"-Befehl deklariert wurden und auf Workbook, Worksheet, Range usw. zeigen, sollten am Ende der Sub/Function wieder deaktiviert werden.
Dies macht man wie folgt:
Set wks = Nothing
Set Rng = Nothing
Damit wird die Variable nicht gelöscht, sondern die Variable ist so leer wie am Anfang, als sie deklariert wurde. Man sollte also die Sub/Function nicht einfach mit "Exit Sub" mitten im Programm verlasen, wenn noch Objektvariablen offen sind.
Zu deinem anderen Problem. Ich habe nicht verstanden, wann Du wirklich die Vba-Routine verlassen willst. In dem Anfangsposting hieß es, das alle mehrfach gefundenen Werte bis auf die 1. Fundstelle gelöscht werden sollen (in allen vorhandenen Tabellen). Im 2. Posting soll bereits nach dem 1. Löschen das Programm beendet werden.
Vielleicht erklärst Du nochmals, was genau passieren soll.
Gruß von Luschi
aus klein-Paris
Anzeige
AW: Suchen markieren löschen
24.02.2006 08:54:30
Volker
Hallo Luschi,
Danke für Deine Antwort.
Wer den Aufbau nicht kennt für den ist es warscheinlich schwer nachzuvollziehen.
Ich gebe Daten über eine UF in ein Tabellenblatt ein. Jeder Wert wird gelistet. Dann an verschiedene Tabellenblätter verteilt (momentaner Lagerort). Ich habe die CB`s in der UF über RowSource gefüllt. Diese Daten stehen in den letzten Tabellenblättern.(Gesamtmaterialbestand) Da jede Artikelnummer nur einmal vorkommen kann,
möchte ich vor der Übergabe wissen wo sich der Artikel bis jetzt befand und ihn vom
bisherigen Lagerort streichen und dann an einen neuen Lagerort übergeben.
Allerdings darf der Artilel aus der Liste des Gesamtlagerbestandes nicht gelöscht werden.
Ich hoffe Du kannst damit etwas anfangen.
Danke für Deine Mühe
Gruß Volker
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige