Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.04.2024 16:47:14
Wörter in verschiedenen Zellen suchen und Wert zurückgeben
16.04.2024 16:22:58
Pivot
16.04.2024 15:29:29
Notizen einheitliche Position, Formatierung per Bezugsspalte
16.04.2024 15:16:53
Summen mit verschiedenen Variablen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
412to416
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
412to416
412to416
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Suchmaske

Suchmaske
doro
hallo
ich bin binden nerven fertig...
seit tagen suche ich in der recherche nach einem passenden code, konnte aber nichts finden; oder konnte es nicht anpassen, weil meine kenntnisse nicht reichen.
was ich benötige, ist eine suchmaske, mit welcher ich in ALLEN tabellenblätter eine eingabe (z.b. "test", jeder treffer auch zb "testwagen" usw.) in EINEM durchgang suchen kann. von allen gefundenen einträgen möchte ich die ganze zeile (A:M)in das tabellenblatt (tabelle4) übertragen lassen.
bite helft mir, bitte
grüsse doro

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Suchmaske
Ramses
Hallo
keine Suchmaske, aber es geht auch:

Sub MultiSeek()
'Original Unknown
'Modified by Ramses
'Sucht in der gesamten Mappe nach einem Begriff und kopiert die
'gefundene Zeile in eine zu definfierende Ergebnistabelle
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As Date
Dim cr As Long, tarWks As String
tarWks = "Tabelle4" 'Name_der_Zieltabelle
cr = 65536
If Worksheets(tarWks).Cells(cr, 1) = "" Then
cr = Worksheets(tarWks).Cells(cr, 1).End(xlUp).Row
End If
If cr = 0 Then cr = 1
'Suchbegriff definieren
sFind = InputBox("Bitte Suchbegriff eingeben:")
If sFind = "" Then Exit Sub
'Suchbegriff auf Zelle definieren
'sFind = Worksheets("Tabelle1").Range("A1")
For Each wks In Worksheets
If wks.Name = tarWks Then GoTo NextStart
Set rng = wks.Cells.Find(What:=sFind, _
LookAt:=xlPart, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.GoTo rng, True
'Für die Automation kann die "If"-Anweisung auskommentiert werden
If MsgBox("Suchbegriff: " & sFind & ",gefunden in " _
& wks.Name & ", " & rng.Address, vbYesNo + vbQuestion, "Weitersuchen ?") = vbNo Then Exit Sub
wks.Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(cr)
cr = cr + 1
Set rng = Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
NextStart:
Next wks
MsgBox prompt:="Keine neue Fundstelle!"
End Sub

Gruss Rainer
Anzeige
AW: Suchmaske
doro
danke rainer
ich habe den code eingefügt, aber irgendwie funzt es nicht. ich erhalte immer die meldung: 'typen unverträglich'
was kann ich tun?
gruss doro s.
AW: Suchmaske
xXx
Hallo,
ändere
Dim sFind as Date
nach
Dim sFind as String
Gruß aus'm Pott
Udo
AW: Suchmaske
doro
danke udo
das habe ich gemacht. jetzt habe ich nur das problem, dass ich wie im code steht die if-anweisung (weitersuchen) auskommentieren möchte.
wie tu ich das. ich kriege es nicht hin, dass mir die alle fundstellenzeilen ausgegeben werden. ich hate vorhin eine endlosschleife...
danke
AW: Suchmaske
Ramses
Hallo
das ist nicht so einfach,.... weil ich nicht weiss wo deine Zieltabelle steht.
Verschiebe die Zieltabelle ans Ende deiner Mappe und starte den Code von der ersten Tabelle aus.
Dann ändere die Zeile
If wks.Name = tarWks Then GoTo NextStart
in
If wks.Name = tarWks Then Exit Sub
und mach vor das "If MsgBox..." ein Hochkomma. Damit ist die Zeile auskommentiert und wird nicht mehr abgearbeitet.
Gruss Rainer
Anzeige
AW: Suchmaske
tim
sorry rainer
aber der code tut immer noch nicht was er sollte. ich erhalte eine endlosschleife die mir die zeile über der fundstelle x-tausendmal ins sheet (suchen) einfügt. dabei ist der gesuchte wert gar nicht vorhanden.
gruss
AW: Suchmaske
Ramses
Hallo
Ich weiss nicht was du angepasst hast, den Code habe ich jetzt getestet und er funktioniert.
Option Explicit

Sub MultiSeek()
'Original Unknown
'Modified by Ramses
'Sucht in der gesamten Mappe nach einem Begriff und kopiert die
'gefundene Zeile in eine zu definfierende Ergebnistabelle
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
Dim cr As Long, tarWks As String
tarWks = "Tabelle3" 'Name_der_Zieltabelle
cr = 65536
If Worksheets(tarWks).Cells(cr, 1) = "" Then
cr = Worksheets(tarWks).Cells(cr, 1).End(xlUp).Row
End If
If cr = 0 Then cr = 1
'Suchbegriff definieren
sFind = InputBox("Bitte Suchbegriff eingeben:")
If sFind = "" Then Exit Sub
'Suchbegriff auf Zelle definieren
'sFind = Worksheets("Tabelle1").Range("A1")
For Each wks In Worksheets
If wks.Name = tarWks Then Exit Sub
Set rng = wks.Cells.Find(What:=sFind, _
LookAt:=xlPart, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.GoTo rng, True
'Für die Automation kann die "If"-Anweisung auskommentiert werden
If MsgBox("Suchbegriff: " & sFind & ",gefunden in " _
& wks.Name & ", " & rng.Address, vbYesNo + vbQuestion, "Weitersuchen ?") = vbNo Then Exit Sub
wks.Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(cr)
cr = cr + 1
Set rng = wks.Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
NextStart:
Next wks
MsgBox prompt:="Keine neue Fundstelle!"
End Sub

Gruss Rainer
Anzeige

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige