Suchergebnis einfärben
11.02.2019 14:57:18
Raphael
wir haben mittlerweile einen kleinen Code erstellt.
Wir benutzen Excel 2016
Wir haben ein Datenblatt mit Grunddaten von den Spalten A - K (kann aber sein, dass noch welche hinzu kommen..)
Auf dem anderen Sheet haben wir 2 Buttons: 1x Suche und 1x Reset.
Beim Klick auf Suchen öffnet sich eine Inputbox bei der man einen Suchbegriff eingeben kann.
Dieser wird im Sheet Grunddaten gesucht und auf dem anderen Sheet ausgegeben, danach wird weiter gesucht, da der Begriff mehrfach vorkommen kann.
Nachdem wir alle Daten haben die wir haben wollen kommen wir zu unseren Problemen:
Es kann sein das der gesuchte Begriff z.B. einmal in der Spalte A vorkommt und einmal in der Spalte D
Zum einen würden wir gerne das Feld mit dem Suchwort einfärben.
Das andere Problem:
Es werden Namen und E-Mail Adressen in der Tabelle genannt. Wenn ich also einen Namen angebe, spuckt mir Excel die selbe Zeile 2x aus: einmal wegen dem Namen an sich, einmal wegen der E-Mail Adresse. Dies würden wir gerne verhindern...
Hier ist unser Code:
Sub Suchen()
Dim rngFind As Range
Dim strTitel As String
Dim sFirstAdress As String
'Suchfeld aktivieren
strTitel = InputBox("Suche nach folgendem Bauteil:", "Suchbegriff bitte eingeben", , 50, - _
_
_
50)
'Falls auf Abbrechen geklickt wird, Makro beenden
If strTitel = "" Then Exit Sub
'Tabelle in "Bauteilverzeichnis" löschen
Sheets("Bauteilverzeichnis").Select
Range("A12:M280").Select
Selection.ClearContents
'Rahmen entfernen
Sheets("Bauteilverzeichnis").Rows("13:500").Delete
'Wo wird überall gesucht: Grunddaten in Spalte A:M
Set rngFind = Worksheets("Grunddaten").Range("A:M").Find(strTitel)
If rngFind Is Nothing Then
MsgBox "Wert " & strTitel & " nicht gefunden!"
Else
sfirstaddress = rngFind.Address
Do
rngFind.EntireRow.Copy
Worksheets("Bauteilverzeichnis").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) _
_
_
.PasteSpecial Paste:=xlPasteAll
Set rngFind = Worksheets("Grunddaten").Range("A:M").FindNext(rngFind)
Loop While Not rngFind Is Nothing And rngFind.Address sfirstaddress
End If
'DoneFinding = MsgBox("Die Suche ist abgeschlossen.")
End Sub
Ich hoffe Ihr könnt uns weiterhelfen.
Viele Grüße,
Raphael