Suche nach Text

Guten Tag zusammen
Ich habe zum Thema Textsuche im Excel bereits eine Beitrag geschrieben und auch eine hilfreiche Antwort erhalten. Jetzt habe ich aber Lunte gerochen und möchte diese Funktion auch auf andere Excel Files anwenden. Damit habe ich aber einige Probleme, welche ich bei meinem ersten Beitrag zum Teil Nachgefragt habe, aber dazu noch keine Antwort erhalten habe.
Grundlage ist eine Auflistung mit X hunderter Zeilen. Mit einem Button soll jetzt eine spezifische Spalte durchsucht werden, Zeilen mit einem Treffer markiert und unterhalb der Zeile 2 eingefügt werden.
Mit dem Code den ich hatte und von Anton erweitert wurde, funktioniert das Grundsätzlich. Folgende Optimierungen würde ich gerne umsetzte, brauche aber ein wenig Hilfe dazu.
1. Im bestehenden Code erkenne ich nicht, wo definiert ist, welche Spalte durchsucht werden soll. Momentan wird ja nur Spalte A durchsucht. Wenn ich jetzt aber z.B. Spalte B durchsuchen möchte, wo muss ich das Ändern?
2. Das zu durchsuchende Blatt ist schreibgeschützt, was natürlich eine Fehlermeldung bei der Ausführung des Makros auslöst.
Entsprechend müsste das Makro zuerst den Blattschutz aufheben, Suchen, markieren und kopieren und dann wieder aktivieren.
etwa so?
ActiveWorkbook.Sheets("Blatt1").Unprotect
ActiveWorkbook.Sheets("Blatt1").Protect
Aber wo genau muss ich das einsetzten?
3. Die gefunden Zeilen mit einem Treffer werden ja einerseits farblich markiert, aber auch kopiert und unter die erste Zeile eingefügt.
Zwei Probleme habe ich damit. Das erste ist, dass wenn ich bei der 1. Suche zum Beispiel 3 Treffer habe, werden die unter die zweite Zeile kopiert. Bei einer weiteren Suche, die z.B. nur 2 Treffer ha werden die ersten zwei Zeilen überschrieben aber die 3. (aus der 1. Suche) bleibt bestehen. Das Suchergebnniss aus der 1. Suche sollte aber gelöscht werden.
Das zweite Problem ist, dass es wenn die Anzahl der Treffer höher ist, als die Zeilenanzahl welche ich zwischen 1 und der Liste habe, werden die Zeilen der Liste überschrieben. Super wäre, wenn sich die Liste nach unten verschieben würde.
4. Meine Listen sind Importen aus dem SAP, leider waren die Erfasser sehr kreativ und inkonsequent bei den Texten. Entsprechen wurde nicht auf Gross- und Kleinschreibung geachtet, Mal mit Leerschlag Mal mit underline geschrieben, etc. Wie kriege ich es hin, dass auch Teilergebnisse gefunden werden?
5. Und zu guter Letzt, würde ich gerne eine "OutputBox" mit der Meldung keine Treffer sehen, als eine Fehlermeldung wenn nichts gefunden wurden.
Ich weiss, dass sind viele Frage, mir ist auch klar, dass man mir hier keiner ein Pfannenfertiges Makro serviert, ich bin jedoch für jede Hilfe und jeden Hinweis dankbar.
Beispieldatei:

Die Datei https://www.herber.de/bbs/user/110032.xlsm wurde aus Datenschutzgründen gelöscht

Gruss
Lenny

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Suche nach Text

15.12.2016 13:07:01

Michael

Option Explicit Sub Name_Markieren() Dim suchName As String, suchBlatt As String Dim zeLLe As Range Dim markRange As Range, suchBereich As Range Dim maxZ As Long ' max. Zeilen Const sSpalten = "A:A,C:E" ' Notation für Range() suchBlatt = Range("K1") With Sheets(suchBlatt) Set suchBereich = Intersect(.Range(sSpalten), .UsedRange) If suchBereich Is Nothing Then MsgBox "Bereich paßt nicht": Exit Sub .Range("A2").CurrentRegion.Interior.ColorIndex = xlNone End With MsgBox suchBereich.Address ' nur zur Info ' Das habe ich mal auskommentiert: Du weißt ja, von welchen Blättern ' aus Du diese Sub aufrufst! '' ' Bei Diagrammblättern gleich raus '' If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub suchName = InputBox("Suchbegriff eingeben:", "Suchfeld") If suchName = "" Then Exit Sub Range("A3").CurrentRegion.Clear suchName = LCase(suchName) ' einmal reicht, das kostet sonst nur Zeit Application.ScreenUpdating = False ' nicht True For Each zeLLe In suchBereich If InStr(LCase(zeLLe), suchName) 0 Then If markRange Is Nothing Then Set markRange = zeLLe Else Set markRange = Union(markRange, zeLLe) End If End If Next If Not markRange Is Nothing Then With markRange.Interior .ColorIndex = 4 .Pattern = xlSolid End With markRange.EntireRow.Copy Range("A3") Else MsgBox "nix gefunden in " & suchBlatt & "." End If End Sub

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Suche nach Text

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread