Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1672to1676
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Suchergebnis einfärben

Suchergebnis einfärben
11.02.2019 14:57:18
Raphael
Hallo zusammen,
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

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchergebnis einfärben
11.02.2019 16:35:32
Piet
Hallo Raphael
ich gehe gleich in Urlaub und kann den Code nicht mehr anpassen.Statt die ganze Zeile kannst du Spalten kopieren, s unten:
Worksheets("Grunddaten").Cells(rngFind.Row, 1).Resize(1, 2).Copy - über rfind.Row,1 kannst du die erste Spalte ab wo kopiert wird angeben, und Resize vergrössert den Bereich nach Rechts um die angegeben Spaltenzahl. Im Beispiel unten wird in der gefundenen rfind Zeile die Spalten A+B kopiert!
In der Zieltabelle musst du nur die erste Zieladresse angeben, Resize erledigt automatisch den Rest. So kopiert man Blockweise.
2.Alternative:
Du kopierst nach wie vor die ganze Zeile, und löscht nachher die unerwünschten Zellen mit Cells(xxx,yy).Value = Empty!
Beides funktioniert! Was für dich einfacher zu Programmieren ist musst du entscheiden.
mfg Piet
    If rngFind Is Nothing Then
MsgBox "Wert " & strTitel & " nicht gefunden!"
Else
sfirstaddress = rngFind.Address   'LastZelle in Spalte A suchen
lz1 = Worksheets("Bauteilverzeichnis").Cells(Rows.Count, 1).End(xlUp).Row
Do
lz1 = lz1 + 1  'Resize verbreitet um x Spalten, hier um 2, A+B
Worksheets("Grunddaten").Cells(rngFind.Row, 1).Resize(1, 2).Copy
Worksheets("Bauteilverzeichnis").Cells(lz1, 1).PasteSpecial Paste:=xlPasteAll
Set rngFind = Worksheets("Grunddaten").Range("A:M").FindNext(rngFind)
Loop While Not rngFind Is Nothing And rngFind.Address  sfirstaddress
End If

Anzeige
AW: Suchergebnis einfärben
11.02.2019 16:41:59
Piet
Nachtrag
wenn die gefundene Zelle noch farblich markiert werden soll dann so: - Farbcode selbst aendern
        Do
lz1 = lz1 + 1  'Resize verbreitet um x Spalten, hier um 2, A+B
rfind.ColorIndex = 4   'gelb  gefundene Zelle gelb markieren
Worksheets("Grunddaten").Cells(rngFind.Row, 1).Resize(1, 2).Copy
Worksheets("Bauteilverzeichnis").Cells(lz1, 1).PasteSpecial Paste:=xlPasteAll
Set rngFind = Worksheets("Grunddaten").Range("A:M").FindNext(rngFind)
Loop While Not rngFind Is Nothing And rngFind.Address  sfirstaddress

AW: Suchergebnis einfärben
12.02.2019 08:33:31
Raphael
Hallo Piet,
vielen Dank für deine Mühe! leider ist es nicht ganz das was wir haben wollten, Daniel konnte uns da ein bisschen besser helfen :)
Einen schönen Urlaub dir!
Gruß,
Raphael
Anzeige
AW: Suchergebnis einfärben
11.02.2019 17:15:48
Daniel
Hi
als erstes fällt auf, dass du den Variablennamen im Code anders schreibst als du ihn deklariert _ hast:

Dim sFirstAdress    As String
sfirstaddress = rngFind.Address
rngFind.Address  sfirstaddress

du solltest schon darauf achten, dass du die Variablen richtig schriebst, sonst kann es sein, dass dein Code nicht richtig funktioniert.
das fällt hier eigentlich sofort auf, weil du bei der Dimensionierung Großbuchstaben verwendest, während im Code die Variablen klein geschrieben sind.
Wenn VBA eine dimensionierte Variable erkennt, passt es automatisch die Groß/Kleinschreibung an, das hilft beim Erkennen von Schreibfehlern.
Außerdem solltest du besser mit OPTION EXPLICIT arbeiten.
Dann erkennt VBA automatsich, ob du dich bei den Variablennamen verschrieben hast, weil es dann nur dimensionierte Variablen zulässt.
jetzt zu deiner Frage:
die Wiederholung kannst du vermeiden, wenn du bei .FINDNEXT als ausgangsprunkt für die weitere Suche die letzte Zelle der jeweiligen Zeile angibst, dann beginnt die Suche erst in der nächsten Zeile und du bekommst keine Dopplungen, wenn der Suchtext in der gleichen Zeile mehrfach vorkommt:
 Set rngFind = Worksheets("Grunddaten").Range("A:M").FindNext(rngFind.Offset(0, 13 - rngFind.column))

wobei sich die 13 nach der letzten Spalte des durchsuchten Bereichs richtet (A:M)
außerdem solltest du bei der ersten Suche einstellen, dass der Bereich zeilenweise durchsucht wird:
Set rngFind = Worksheets("Grunddaten").Range("A:M").Find(strTitel, SearchOrder:=xlbyRows)
das mit dem Einfärben würde ich so regeln:
1. im Code den Suchtext in eine freie Zelle schreiben
2. die Färbung dann über die Bedingte Formatierung regeln.
Gruß Daniel
Anzeige
AW: Suchergebnis einfärben
12.02.2019 08:28:37
Raphael
Hallo Daniel,
vielen Dank für die Hilfe, das funktioniert super. Denke das mit der Ausgabe bekommen wir auch hin :)
Bezüglich der Variable...ist mir leider nicht aufgefallen das diese ungleich ist. Aber du hast natürlich schon recht, sollte gleich sein!
Danke nochmal!
Gruß,
Raphael

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige