String suchen innerhalb einer Zeichenkette

Hallo,
ich komme leider nicht ganz klar mit folgendem Problem, wo es darum geht, dass ich einen String innerhalb einer anderen Zeichenkette finden möchte. Falls vorhanden, soll in der Nebenspalte ein Wert zugewiesen werden.
Dafür habe ich in Tabelle1 in Spalte 1 ab Zeile 2 verschiedene Bezeichnungen stehen, z.B "dies ist ein Text A123". In Tabelle2 habe ich in Spalte 1 meine Suchbegriffe stehen, z.B. A123 und daneben einen Wert, z.B. "Schlüssel 3". Nun möchte ich alle meine Suchbegriffe aus Tabelle 2, Spalte 1 durchgehen und prüfen, ob diese in Tabelle1, Spalte 1 irgendwo enthalten sind. Falls gefunden, wird der Schlüssel übertragen. Sollte eine Bezeichnung zwei Suchbegriffe enthalten, würde das Ergebnis z.B. "Schlüssel 3/Schlüssel 5" lauten. Groß-/Kleinschreibung wird nicht unterschieden.
Wie könnte ich das am besten angehen?
Im voraus vielen Dank für Unterstützung.
Grüße, Constantin
https://www.herber.de/bbs/user/105561.xlsx

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Function SchlüsselZuweisen(txt As String, Typ As Range, Schlüssel As Range) As String Dim arrT, arrS Dim z As Long arrT = Intersect(Typ, Typ.Worksheet.UsedRange).Value arrS = Intersect(Schlüssel, Schlüssel.Worksheet.UsedRange).Value For z = 1 To UBound(arrT, 1) If arrT(z, 1) "" Then If UCase(txt) Like UCase("*" & arrT(z, 1) & "*") Then SchlüsselZuweisen = SchlüsselZuweisen & "/" & arrS(z, 1) End If End If Next If Len(SchlüsselZuweisen) > 0 Then SchlüsselZuweisen = Mid(SchlüsselZuweisen, 2) End Function

Hallo Constantin,
da war ich wohl etwas zu langsam, hatte bereits ein Makro entwickelt.
Hier der vollstaendigkeit halber meine Makro Lösung. Bin gerade fertig geworden.
mfg Piet

Option Explicit      '14.5.2016  Piet für Herber Forum
Dim Tab1 As Object, lz1 As Long
Dim Tab2 As Object, lz2 As Long
Dim AC As Object, rFind As Object
Dim Adr1 As String, AdrN As String
Dim Schlüssel As String, Txt As String
Dim SuchName As String
'Zeichen suchen ; Schlüssel notieren
'Variante 1:  mit Space bei Schlüssel
Sub Suche_Zeichen_in_Zeichenkette_1()
Set Tab1 = Worksheets("Tabelle1")   'Tabelle1
Set Tab2 = Worksheets("Tabelle2")   'Tabelle2
'letzte Zeile in Tabelle 1+2 finden
lz1 = Tab1.Range("A2").End(xlDown).Row
lz2 = Tab2.Range("A2").End(xlDown).Row
'alte Schlüssel Tabelle in B löschen
Tab1.Range("B2:B" & lz1).ClearContents
'Schleife für alle Typen in Tabelle2 Spalte "A"
For Each AC In Tab2.Range("A2:A" & lz2)
'Such-Name laden:  (ohne oder mit Space)
SuchName = AC.Value    'Such-Name ohne Space
'Suchlauf nach AC Wert in Tabelle1 Spalte "A"
Set rFind = Tab1.Range("A1:A" & lz1).Find(What:=SuchName, After:=Tab2.Range("A1"), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
Adr1 = rFind.Address           '1. gefundene Adresse
AdrN = rFind.Address           '1. next Adresse
Schlüssel = AC.Cells(1, 2)     '"B" Schlüssel laden
'Text aus Spalte B laden  (voriger Schlüssel)
Txt = rFind.Cells(1, 2).Value
If InStr(Txt, Schlüssel) = 0 Then
If Txt  "" Then Txt = Txt & " / "   'mit Space
rFind.Cells(1, 2) = Txt & Schlüssel   '1. Gefund. Schlüssel
End If
Do  'Do Loop für weitere Typen bis End Zeile
Set rFind = Tab1.Range("A2:A" & lz1).FindNext(After:=Tab2.Range(AdrN))
If rFind Is Nothing Then Exit Do Else AdrN = rFind.Address
'Text aus Spalte B laden  (voriger Schlüssel)
Txt = rFind.Cells(1, 2).Value
If InStr(Txt, Schlüssel) = 0 Then
If Txt  "" Then Txt = Txt & " / "   'mit Space
rFind.Cells(1, 2) = Txt & Schlüssel   'next Schlüssel
End If
Loop Until AdrN = Adr1
End If
Next AC
End S

Beliebteste Forumthreads (12 Monate)

String suchen innerhalb einer Zeichenkette

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

String suchen innerhalb einer Zeichenkette

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread