Suchmakro abändern

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

Betrifft: Suchmakro abändern von: Heinrich
Geschrieben am: 06.02.2005 10:30:38

Hallo zusammen

Folgendes Makro sucht in allen Tabellenblättern den eingegebenen Suchbegriff
in Spalte 4 ( Es wird nur der letzte Eintrag berücksichtigt ) und zeigt mir dann das Ergebnis an.


Sub Suchen()
Dim wks As Worksheet
Dim sFind As String
Dim laR As Long
Dim ant As Byte
sFind = InputBox("SuchenText ")
If sFind = "" Then Exit Sub

For Each wks In Worksheets
With wks
laR = .Cells(117, 4).End(xlUp).Row
If laR >= 6 And laR <= 116 Then
If .Cells(laR, 4).Text = sFind Then
Application.Goto .Cells(laR, 4), True
ant = MsgBox("gefunden" & .Name & " " & _
vbCr & vbCr & "Soll weiter gesucht werden ?", vbYesNo + vbQuestion)
If ant <> 6 Then Sheets("Plan").Select
Range("F2:O3").Select
If ant <> 6 Then Exit Sub
End If
End If
End With
Next wks
MsgBox "Es wurde keine weiterer Eintrag gefunden !"

Sheets("Plan").Select
Range("F2:O3").Select



Mein Problem

Ich möchte gerne das auch Einträge gefunden werden die nicht 100% mit der Sucheingabe
übereinstimmen. Z.B Groß und Kleinschreibung oder bei Eingabe
Klaus soll auch der Eintrag Klaus Dieter angezeigt werden.
Hoffe das ich mich einigermaßen verständlich ausgedrückt habe und
mir jemand helfen kann.


Gruß
Heinrich

Bild


Betrifft: AW: Suchmakro abändern von: Josef Ehrensberger
Geschrieben am: 06.02.2005 10:35:54

Hallo Heinrich!

Ändere die Zeile

 If .Cells(laR, 4).Text = sFind Then

um in

If InStr(1, LCase(.Cells(laR, 4).Text), LCase(sFind)) > 0 Then

dann sollte es klappen

Gruß Sepp

P.S.: Rückmeldung nicht vergessen!


Bild


Betrifft: AW: Suchmakro abändern von: Ramses
Geschrieben am: 06.02.2005 10:40:42

Hallo

Die Schleife für eine ganze Mappe mit einzelner Zellprüfung, dauert zu lange
Probier das mal

Option Explicit



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 & Chr$(13) & "Weitersuchen ?", 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


Bild


Betrifft: AW: Suchmakro abändern von: Heinrich
Geschrieben am: 06.02.2005 10:56:02

Hallo Josef, Hallo Ramses

Genau so habe ich mir das Vorgestellt
Funktioniert einwandfrei
Vielen Dank für die schnelle Hilfe

Den Code von Ramses werde ich die Tage mal ausprobieren
Vielen Dank auch an Dich.

Wünsche Euch noch einen schönen Sonntag

Gruß
Heinrich


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Blatt einzeln mit Pfadangabe speichern"