Suche eines Wertes in 2 verschiedenen Spalten
17.10.2016 10:57:45
Thomas
ich bräuchte bitte Hilfe bei einer Makro-Suchfunktion. Bisher wurde ich nirgends fündig bzw. konnte es nicht entsprechend anpassen:
Ich schreibe an einer Lagerliste (also Text) und da viele noch ahnungslosere Leute als ich es bin, diese bearbeiten sollen, habe ich eine Makro-Suche eingebaut, die Folgendes können sollte:
1) Suchbegriffsteile eingeben z.B.: nad
2) Ergebnis wird in Spalte A und Spalte P (wo weitere alternative Namen für das Produkt angeboten werden) gesucht. (falls das nicht geht, würde ich die Begriffe einfach mit weißer Schrift in Spalte A eintragen - ist meine derzeitige Lösung)
3) 1. Suchergebnis wird in Messagebox angezeigt (derzeit wird leider die Position angezeigt - hier hätte ich gerne den Begriff, der in der Zelle gefunden wurde - also im Beispiel "Nadel (blau)"
4) Außerdem sollte die gefundene Zelle mit gelbem Hintergrund belegt werden.
5) Falls es nicht der richtige Begriff ist - Weitersuchen "ja" - Zelle wieder zurück in Ursprungsfarbe
6) Nächste Messagebox mit "Nadel (rosa)"
7) Ende wenn keine weiteren Begriffe gefunden werden können. Idealerweise mit Messagebox ("keine weiteren Produkte gefunden") oder wenn Weitersuchen "nein"
Wichtig ist, dass am Ende der Suche auch die Originalfarbe der Spalte wiederhergestellt wird.
Danke schon einmal vorab!
Hier ist mein derzeitiges Suchmakro:
Sub Suche()
Dim rng As Range
Dim sBegriff As String, sAddress As String
sBegriff = InputBox("Bitte Suchbegriff eingeben:", "Suchbegriff eingeben", , 5, 5)
If sBegriff = "" Then Exit Sub
Set rng = Columns("A:A").Find( _
What:=sBegriff, _
LookIn:=xlFormulas, _
MatchCase:=False)
If rng Is Nothing Then
Beep
MsgBox "Suchbegriff nicht gefunden!", , _
Application.UserName
Exit Sub
End If
sAddress = rng.Address
rng.Select
If (MsgBox(rng.Address(False, False), vbYesNo, "Weitersuchen?")) = vbYes Then
rng.Offset(1).Select
Do
Columns("A:A").FindNext(After:=ActiveCell).Activate
If ActiveCell.Address = sAddress Then Exit Sub
If (MsgBox(ActiveCell.Value(False, False), vbYesNo, "Weitersuchen?")) = vbNo Then Exit Do
Loop
End If
End Sub