Text in Tabelle suchen

Question

Hallo Zusammen,

ich bin recht neu und hoffe meine Frage nicht allzu stümperhaft zu stellen...

Also mein Problem ist folgendes:

Ich möchte nach Eingabe einer Zahlenfolge oder eines Textes in Tabelle 2 diesen in Tabelle 1 suchen. Falls der gesuchte Text (oder Zahlenfolge oder beides in Kombi) gefunden wird, soll der Wert/Text aus Spalte 1, gleiche Zeile wie der gesuchte Wert/Text, im Feld neben dem Eingabefeld ausgegeben werden. Gleichzeitig soll der Wert oder Text rechts neben der gesuchten Zelle in Tabelle 2 mit angezeigt werden. :-D Kompliziert erklärt.

Beispiel:

Eingabe in Tabelle2,A3: 0815halogenstab
Jetzt kommt der Suchmechanismus!

Gefunden wird: 0815Halogenstab in Tabelle1,E1350; in F1350 steht "der Stab passt nicht überall"; in A1350 steht "Halogenstab 500W".

Ausgabe in Tabelle2,B3: Halogenstab 500W (Wert aus A1350)
Ausgabe in Tabelle2,D3: 0815Halogenstab (Wert aus E1350)
Ausgabe in Tabelle2,F3: der Stab passt nicht überall (Wert aus F1350)

Ende.

Der Text in Klammern (Wert aus..) sollte wenn möglich auch erscheinen, am besten in einer eigenen Zelle z. B. C3 usw.

Ich möchte einfach in A3 bis A140 (oder mehr) eintippen und die Suchergebnisse sollen am Besten direkt erscheinen. Groß-Kleinschreibung soll ignoriert werden.

Wäre wirklich super wenn Ihr mir hier helfen könntet, ich überlege jetzt schon mehrere Jahre daran und bin nur zufällig auf dieses Forum gestoßen.

Gruß, Hobyprogger.

Answer 1

hi all ^^

ein beispiel :-)

gruss nighty

einzufuegen

alt+f11/projektexplorer/DeineTabelle bzw ("Tabelle2")

Private Sub worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Row = 3 And Target.Column = 1 Then
Dim suche As Range
Dim merker As Boolean
Set suche = Worksheets(1).Range("A1:A" & Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row).Find(Worksheets(2).Cells(3, 1))
If Not suche Is Nothing Then
Letzte = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets(2).Cells(Letzte, 1) = Worksheets(1).Cells(suche.Row, 1)
Worksheets(2).Cells(Letzte, 2) = Worksheets(1).Cells(suche.Row, 2)
Worksheets(2).Cells(Letzte, 4) = Worksheets(1).Cells(suche.Row, 4)
Worksheets(2).Cells(Letzte, 6) = Worksheets(1).Cells(suche.Row, 6)
End If
End If
Application.EnableEvents = True
End Sub

Answer 2

hi all ^^

korrigiert

gruss nighty

Private Sub worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Row = 3 And Target.Column = 1 Then
Dim suche As Range
Dim Letzte As Long
Set suche = Worksheets(1).Range("A1:A" & Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row).Find(Worksheets(2).Cells(3, 1))
If Not suche Is Nothing Then
Letzte = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets(2).Cells(Letzte, 1) = Worksheets(1).Cells(suche.Row, 1)
Worksheets(2).Cells(Letzte, 2) = Worksheets(1).Cells(suche.Row, 2)
Worksheets(2).Cells(Letzte, 4) = Worksheets(1).Cells(suche.Row, 4)
Worksheets(2).Cells(Letzte, 6) = Worksheets(1).Cells(suche.Row, 6)
End If
End If
Application.EnableEvents = True
End Sub