Arbeitsmappenweise Suchfunktion

Forumthread: Arbeitsmappenweise Suchfunktion

22.08.2005 14:01:15

Sven

Hallo
Ich bin auf der Suche nach einer Suchfunktion die eine gesamte Arbeitsmappe nach einem Suchbegriff durchsucht.
Am besten wäre es, wenn ein besimmter Feldinhalt ausgegeben würde, sobald der Suchbegriff in einem Arbeitsblatt gefunden wird und das für jeden Treffer. Also bspw. wenn der Begriff "Layout" in mehreren Blättern gefunden wird, soll aus dem betreffenden Blatt immer Feld "A1" ausgegeben werden.
Jemand eine Idee? Kenne mich leider mit VBA/Makros nicht besonders aus.
Gruß Sven

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Arbeitsmappenweise Suchfunktion

22.08.2005 14:27:37

=Peter=
AW: Arbeitsmappenweise Suchfunktion

22.08.2005 14:43:26

Sven
AW: Arbeitsmappenweise Suchfunktion

22.08.2005 16:00:50

Ramses

AW: Arbeitsmappenweise Suchfunktion

22.08.2005 14:27:37

=Peter=

Hallo Sven,
vielleicht hilft dir das: http://users.quick-line.ch/ramel/Files/Suchen_alle_Tabellen.XLA
HTH
Gruss
Peter

AW: Arbeitsmappenweise Suchfunktion

22.08.2005 14:43:26

Sven

Hallo Peter
Danke für die Hilfe. Also die Suche ist schon mal nicht schlecht.
Vielleicht bekomm ich damit das gewünschte Ergebnis. Das Problem ist noch wenn das gefundene Feld außerhalb des Bildhschirms ist. Dann fehlen die Felder links davon und die sind wichtig. Aber vielleicht kann ich da noch was austüfteln.
Sven

AW: Arbeitsmappenweise Suchfunktion

22.08.2005 16:00:50

Ramses

Hallo
das wäre eine andere Variante
Sub MultiSeek()
    '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
    'Name_der_Zieltabelle
    'Bitte Anpassen !!!!
    tarwks = "Tabelle3"
    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

Beliebteste Forumthreads (12 Monate)

Forumthread: Arbeitsmappenweise Suchfunktion

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread