Arbeitsmappe durchsuchen

Forumthread: 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

AW: Arbeitsmappe durchsuchen

Ramses

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

Beliebteste Forumthreads (12 Monate)

Forumthread: Arbeitsmappe durchsuchen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread