so gut wie möglich
06.07.2016 18:02:51
Michael
Hi René,
wie Nilo schon sagt: ohne eindeutige ID geht eigentlich gar nix.
Alte Geschichte: verschiedene Artikellisten unterschiedlicher Zulieferer haben unterschiedlich Nummern, Bezeichnung usw.
Aber: ist es nicht so, daß die Teile mittlerweile eindeutige EAN-Codes haben? Da sollte man die Herren Zulieferer halt vergattern, daß sie DIE verwenden oder zumindest mit angeben...
Alles andere ist Stückwerk und ohne händische Nachbearbeitung nicht sinnvoll.
Ich habe Dir mal ein Makro geschrieben, das
- jedes Zeichen außer " ", 0..9 und A..Z durch ein Leerzeichen ersetzt
- alles, was nicht mindestens 3 Zeichen hat, fliegt raus
- nach dem Rest sucht und die Treffer in max. 5 Spalten nebeneinander ausgibt.
Das ist quasi ein Zwischenschritt zu einer "guten" (naja, nur etwas "besseren") Lösung, die dann vergleicht, ob wenigstens EIN Treffer bei verschiedenen Begriffen auftaucht.
Datei: https://www.herber.de/bbs/user/106823.xlsm
Es sieht aber wirklich böse aus: z.B. ergibt REIFEN-GLEIT/MONTIERPASTE
>REIFEN
>GLEIT
[keine Ausgabe bei Montierpaste, da nicht gefunden]
da stimmt nix überein!
Spiel halt mal damit herum, dann sehen wir weiter.
Schöne Grüße,
Michael
P.S.: ich seh grad, daß KEIN Treffer der Reifen "Reifen" findet, sondern ALLE nur "...stREIFEN"
Deshalb habe ich das Makro noch modifiziert, so daß der Begriff unterdrückt wird, wenn nicht links davon ein Leerzeichen steht:
Sub WS_zu()
Dim aWS
Dim maxz&, i&, r1&, maxWS&, p&, p0&, sp&, tr&
Dim c As Range, suchIn As Range
Dim sh As Worksheet
Dim w
Const spmax = 5
Set sh = Sheets("Tabelle1")
maxz = Range("B" & Rows.Count).End(xlUp).Row
Range("C" & 2).Resize(maxz, spmax).ClearContents
aWS = Range("B2").Resize(maxz, spmax)
maxWS = sh.Range("B" & sh.Rows.Count).End(xlUp).Row
Set suchIn = sh.Range("B1").Resize(maxWS)
'MsgBox suchIn.Address
For i = 1 To UBound(aWS) ' !!! bis Arrayende
aWS(i, 1) = CStr(aWS(i, 1))
If Len(aWS(i, 1)) > 2 Then
For p = 1 To Len(aWS(i, 1))
If Not (Mid(aWS(i, 1), p, 1) = " " Or _
(Mid(aWS(i, 1), p, 1) >= "0" And Mid(aWS(i, 1), p, 1) = "A" And Mid(aWS(i, 1), p, 1) 2 Then
Set c = suchIn.Find(w(p), sh.Range("B1"), xlValues, xlPart)
tr = 0
If Not c Is Nothing Then
aWS(i, sp) = ">" & w(p) & " r1
If tr = 0 Then aWS(i, 1) = "" Else sp = sp + 1
End If
End If
If sp > spmax Then Exit For
Next
End If
Next
Range("C2").Resize(maxz, spmax) = aWS
End Sub