Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
656to660
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
656to660
656to660
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Arbeitsmappenweise Suchfunktion

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
Anzeige
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
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige