Anzeige
Archiv - Navigation
456to460
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
456to460
456to460
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Arbeitsmappe durchsuchen

Arbeitsmappe durchsuchen
19.07.2004 10:45:34
Nicole
Hallo alle zusammen,
trotz intensiver Recherche komme ich einfach nicht weiter:
Ich möchte eine Arbeitsmappe (53 Blätter) nach einem Suchbegriff durchsuchen und in eine neue Tabelle mit Tabellenname eintragen lassen (Suchbegriff kann in mehreren Tabellen vorkommen).
Problem ist nur, dass in den Zellen nicht nur der Suchbegriff, sondern auch noch diverse andere Wörter stehen. Außerdem weiß man nicht, ob der gesuchte Begriff Groß- oder Klein geschrieben wurde.
Das Eintragen in eine neue Tabelle bekomm ich selbst hin, ich weiß nur nicht, wie ich suchen soll, wenn in einer Zelle mehrere Wörter stehen.
Danke für die Hilfe.
Nicole

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Arbeitsmappe durchsuchen
Ramses
Hallo
hier mal einen Ansatz für das Suchmodul

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
'Suchbegriff
Dim sFind As Variant
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

Das solltest du anpassen können. Wenn Gross und Kleinschreibung nicht berücksichtigt werden soll, kannst du ja UCASE oder LCASE verwenden.
Gruss Rainer
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige