Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender Navigationstipps
Suchen und auflisten
19.02.2005 13:22:21
Wulfgar
Ich möchte in einer Mappe alle Blätter nach einem Wort oder Wortfragment suchen und mir alle gefundenen Zeilen auf einem neuem Blatt ausgeben lassen.
Mit Makrorecorder aufzeichnen komm ich nicht weiter.
Bin für jede Hilfe dankbar
Ich habe hier folgendes Suchmakro in Gebrauch ,vielleicht kann man das anpassen.

Sub MultiSuche()
Dim Sh As Worksheet
Dim GZelle As Range
Dim FStelle$
Dim SBegriff
SBegriff = InputBox("Bitte Suchbegriff eingeben:")
For Each Sh In Worksheets
Sh.Activate
Set GZelle = Sh.Cells.Find(SBegriff)
If Not GZelle Is Nothing Then
FStelle = GZelle.Address
Do
GZelle.Activate
If MsgBox("WeiterSuchen", vbYesNo + vbQuestion) = vbNo Then Exit Sub
Set GZelle = Cells.FindNext(After:=ActiveCell)
If GZelle.Address = FStelle Then Exit Do
Loop
End If
Next Sh
MsgBox ("Suche beendet.")
End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchen und auflisten
19.02.2005 14:21:46
Josef
Hallo Wulfgar!
Probier mal das!

Sub MultiSeek()
Dim rng As Range
Dim sFirst As String
Dim sFind As String
Dim wks As Worksheet, neu As Worksheet
Dim lRow As Long
sFind = InputBox("Geben sie das gesuchte Wort oder" & vbLf & _
"den gesuchten Wortteil ein:", "Suchen", "Suchbegriff")
If sFind = "" Then Exit Sub
Set neu = Worksheets.Add(before:=Sheets(1))
neu.Name = "Suche_" & Format(Now, "dd.mm.yy_hhmmss")
For Each wks In ThisWorkbook.Sheets
If wks.Name <> neu.Name Then
Set rng = wks.Cells.Find(What:=sFind, LookIn:=xlValues, LookAt:=xlPart)
If Not rng Is Nothing Then
sFirst = rng.Address
Do
lRow = lRow + 1
neu.Cells(lRow, 1) = rng
neu.Cells(lRow, 2) = rng.Address(0, 0)
neu.Cells(lRow, 3) = wks.Name
Set rng = wks.Cells.FindNext(rng)
Loop While rng.Address <> sFirst
End If
End If
Set rng = Nothing
Next
End Sub

Gruß Sepp
P.S.: Rückmeldung nicht vergessen!
Anzeige
AW: Suchen und auflisten
Wulfgar
Das funktioniert super!
Wäre es noch möglich das mir die komplette Zeile aufgelistet wird.
Spalten A bis I sind belegt mit Namen,Adressen,Daten etc. keine Formeln drin.
Gruss Wulgar
AW: Suchen und auflisten
19.02.2005 17:50:12
Josef
Hallo Wulfgar!
Dann so.

Sub MultiSeek()
Dim rng As Range
Dim sFirst As String
Dim sFind As String
Dim wks As Worksheet, neu As Worksheet
Dim lRow As Long
sFind = InputBox("Geben sie das gesuchte Wort oder" & vbLf & _
"den gesuchten Wortteil ein:", "Suchen", "Suchbegriff")
If sFind = "" Then Exit Sub
Set neu = Worksheets.Add(before:=Sheets(1))
neu.Name = "Suche_" & Format(Now, "dd.mm.yy_hhmmss")
For Each wks In ThisWorkbook.Sheets
If wks.Name <> neu.Name Then
Set rng = wks.Cells.Find(What:=sFind, LookIn:=xlValues, LookAt:=xlPart)
If Not rng Is Nothing Then
sFirst = rng.Address
Do
lRow = lRow + 1
wks.Rows(rng.Row).Copy neu.Cells(lRow, 1)
Set rng = wks.Cells.FindNext(rng)
Loop While rng.Address <> sFirst
End If
End If
Set rng = Nothing
Next
End Sub

Gruß Sepp
P.S.: Rückmeldung nicht vergessen!
Anzeige
AW: Suchen und auflisten
Wulfgar
Mann Du bist Spitze
Ich hatte es gerade erst ins Forum gestellt und schon kommt die Lösung.
Das haut jetzt so hin wie ich es wollte.
Herzliches Danke nochmal
AW: Suchen und auflisten
23.02.2005 16:19:38
Andrea
Hi Sepp,
Ich forstere schon seit Tagen die ganzen Einträge durch nach geeigneten Lösung für mein Problem, ich wollte das anders angehen aber dein Makro kann ich auch supper benutzen. Da es für meine Kenntnise aber noch sehr vorgeschritten ist, sag mir bitte wie das ganze ausehen soll, wenn die ganze Zeile ( die samt gesuchten Begriff und nebenstehenden Daten in das neue Blatt koppiert wird wie gehabt) in dem ursprunglichen Blatt komplett gelöscht wird, oder nicht koppiert sondern ausgeschnitten und in das neue Blatt übertragen.
Danke, werde mich sehr freuen
Andrea
Anzeige
AW: Suchen und auflisten
harry
hi,
so müsste es gehen:
Do

lRow = lRow + 1

wks.Rows(rng.Row).Copy neu.Cells(lRow, 1)
wks.Rows(rng.Row).Delete
Set rng = wks.Cells.FindNext(rng)

Loop While rng.Address sFirst

End If
liebe grüße,
harry

309 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige