Suchen und auflisten

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: Suchen und auflisten von: Wulfgar
Geschrieben am: 19.02.2005 13:22:21

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

Bild


Betrifft: AW: Suchen und auflisten von: Josef Ehrensberger
Geschrieben am: 19.02.2005 14:21:46

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!


Bild


Betrifft: AW: Suchen und auflisten von: Wulfgar
Geschrieben am: 19.02.2005 17:43:47

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


Bild


Betrifft: AW: Suchen und auflisten von: Josef Ehrensberger
Geschrieben am: 19.02.2005 17:50:12

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!


Bild


Betrifft: AW: Suchen und auflisten von: Wulfgar
Geschrieben am: 19.02.2005 17:58:05

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


Bild


Betrifft: AW: Suchen und auflisten von: Andrea
Geschrieben am: 23.02.2005 16:19:38

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


Bild


Betrifft: AW: Suchen und auflisten von: harry
Geschrieben am: 23.02.2005 16:42:08

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


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Suchen und auflisten"