Excel oder VBA?

Guten Tag zusammen,
ich habe mal wieder ein Problem und hoffe Ihr könnt mir dabei helfen.
Ich habe 2 Zellen die jeweils unterschiedliche Text,Zahlen und Zeichen Kombinationen enthalten. Ein Teilbereich der Inhalte beider Zellen kann identisch sein. Und genau diese muss ich finden.
In Feld A2 steht zum Beispiel: "S-X12SAU-BR4-O"
In Feld D5 in Tabellenblatt 2 steht zum Beispiel: "120AB Lachmann X12SA, X12SS Serie"
Ich brauche nun eine Funktion die erkennt das "X12SA" aus D5 auch in A2 steht und als Ergebnis C5 nach A1 kopiert. Problematisch ist auch das der Zellinhalt variiert. Die Position (innerhalb der Zelle)der übereinstimmenden Zeichenfolge kann variieren sowie die Zeichenfolge selbst auch. Also ein undefinierbarer Bereich (für mich).
Vielleicht denke ich auch zu umständlich und es geht ganz einfach :-)
Danke und Gruß
Svenler

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public Sub Abgleich() Dim vTemp As Variant Dim iTemp As Integer With ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattnamen ggf. anpassen vTemp = Split(.Range("D5").Value, " ") For iTemp = LBound(vTemp) To UBound(vTemp) vTemp(iTemp) = Replace(vTemp(iTemp), ",", "") If InStr(.Range("A2").Value, vTemp(iTemp)) > 0 Then MsgBox "der Text """ & vTemp(iTemp) & """ wurde in der Zelle ""A2"" gefunden." Exit For End If Next iTemp End With End Sub

Hi zusammen,
das Ding hat mich jetzt gejuckt!
Um es gedanklich griffig zu machen & zu testen, habe ich zunächst Zwischenergebnisse ins Blatt 3 geschrieben.
Da das zu laufen scheint, habe ich alle Tabellenzugriffe entfernt; die Ausgabe erfolgt via msgbox.
Damit stehen alle Daten zur Verfügung: die Länge der gefundenen Übereinstimmung & selbige als String; hier muß man nur noch entscheiden, ob es eine Mindestlänge gibt usw. und den Code um ein, zwei Zeilen ergänzen.
Die Datei: https://www.herber.de/bbs/user/103240.xls
Das Makro:

Sub vergleichenDirekt()
Dim s$(1 To 3), l&(1 To 3)
Dim i&, j&
Dim iMax&, jmax&, Ausgabe$
Dim puffer&()
s(1) = Tabelle1.Range("A2")
s(2) = Tabelle2.Range("D5")
For i = 1 To 2: l(i) = Len(s(i)): Next
If l(1)  iMax Then
iMax = puffer(j)
Ausgabe = iMax & " Zeichen. Begriff: " & Mid(s(3), j - iMax + 1, iMax)
End If
End If
Else
puffer(j) = 0
End If
Next j
Next i
MsgBox "Max. Übereinstimmung: " & Ausgabe
End Sub

Schöne Grüße,
Michael

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread