Ähnliches Material suchen über Hilfstabelle

Rene · 2016-06-14T17:37:48+00:00

Hallo zusammen, die Nervensäge ist es, da es mit Hilfe eine Ähnlickeits-text-marko nicht so funktionierte, dachte ich mir man könnte es per Formel machen aber mit Hilfe einer Zusatztabelle. Anbei ein Foto meines Problems. Habe nur mal schnelle ein BSP aufgestellt. [Bild: Userbild] - Tabelle 1 soll über Tabelle 2 ein ähnliches Material finden und die Sachnummer als Referenz ausgeben. So leider muss ich erstmal Feierabend machen :). Viel Spaß beim Fussball

Hallo Michael,
Danke nochmal jetzt habe ich aber ein Problem, ich habe den Wortstamm gefüllt und auch den Makro von 9 auf 856 erhöht, bei Reiter I (Plan DBS) ist alles korrekt aber bei Reiter III (Archiv) macht er mir "xxx". Kannst du mir helfen. Anbei der Code?
Option Explicit

Sub WS_zuordnenH()
Call WS_zu("H", Plan)
End Sub

Sub WS_zuordnenI()
Call WS_zu("P", Archiv)
End Sub

Sub WS_zu(sp As String, sh As Worksheet)
Dim aWS
Dim maxz&, i&, r1&, maxWS&
Dim c As Range, suchIn As Range
maxz = sh.Range("A" & Plan.Rows.Count).End(xlUp).Row
sh.Range(sp & 2).Resize(maxz).ClearContents
maxWS = WS.Range("A" & Plan.Rows.Count).End(xlUp).Row
WS.Range("B1").Resize(maxWS, 2).ClearContents
aWS = WS.Range("A1").Resize(maxWS, 2)
Set suchIn = sh.Range("B1").Resize(maxz)
For i = 1 To 856
Set c = suchIn.Find(aWS(i, 1), sh.Range("B1"), xlValues, xlPart)
If Not c Is Nothing Then
r1 = c.Row
Do
sh.Range(sp & c.Row).Value = aWS(i, 1)
If sp = "P" Then aWS(i, 2) = aWS(i, 2) & "," & c.Row
Set c = suchIn.FindNext(c)
Loop While Not c Is Nothing And c.Row  r1
End If
Next
If sp = "P" Then WS.Range("A1").Resize(maxWS, 2) = aWS
End Sub

Hi Rene,
a) Du mußt ja nichts LÖSCHEN, nur eine KOPIE des Archivs verwenden, in dem Du die Doppelten entfernt hast - wenn das zu viel hin & her ist, bietet sich auch die Verwendung eines sogenannten "Dictinarys" an - ich baue es mal ein.
b) Dein "Wortstamm" läßt zu wünschen übrig. Suchbegriffe wie "HA" kann man schon verwenden, aber dabei ist Vorsicht geboten (deshalb "paß bloß uff"):
Kopiere das Makro mal in die Tabelle WS:

Option Explicit
Sub plausi()
Dim maxz&, i&, r1&, maxWS&
Dim c As Range, suchIn As Range
Dim begriff$, b0$, aWS
maxWS = Range("A" & Rows.Count).End(xlUp).Row
aWS = Range("A1:A" & maxWS)
Range("C1:C" & maxWS).Clear
Set suchIn = Range("A1:A" & maxWS)
For i = 1 To maxWS ' !!! bis Arrayende= (derzeit) 850
begriff = ""
Set c = suchIn.Find(aWS(i, 1), suchIn(1), xlValues, xlPart)
If Not c Is Nothing Then
r1 = c.Row
Do
begriff = begriff & "-" & c.Value & " (" & c.Row & ")"
Set c = suchIn.FindNext(c)
Loop While Not c Is Nothing And c.Row  r1
If begriff  "-" & aWS(i, 1) & " (" & i & ")" Then _
Range("C" & i) = begriff
End If
Next
End Sub

Das findet und schreibt Doppelte und mehrfach "ineinander" vorkommende Teilbegriffe. Dabei fällt auf:
aa)- TUERAUSSENGRIFF (739)-TUERAUSSENGRIFF (1) kommt also sowohl in Zeile 1 als auch in Zeile 739 vor. Das ist von der Datenkonsistenz her unkritisch, das Makro läuft aber länger als nötig.
ABER: Du hast bei manchen Begriffen führende und/oder nachfolgende Leerzeichen: z.B. in Zeile 739; das bedeutet wiederum, daß der 739er NICHT in Deinen Daten gefunden wird, falls er dort nicht auch ein Leerzeichen VOR dem Begriff enthält.
Ich habe diesen Umstand in meiner Datei mit dem nachfolgenden Makro geglättet (wiederum in WS):

Sub glaetten()
Dim i&, maxWS&
Dim aWS
maxWS = Range("A" & Rows.Count).End(xlUp).Row
aWS = Range("A1:A" & maxWS)
For i = 1 To maxWS
aWS(i, 1) = Trim(LTrim(aWS(i, 1)))
Next
Range("A1:A" & maxWS) = aWS
End Sub

bb) -FLA (7)-REIFENDICHTMITTELFLASCHE (195)
FLA ist in Flasche (oder, was nicht vorhanden ist aber sein könnte, Flansch) enthalten. Wenn FLA vor Flasche in der Liste steht, ist es unproblematisch, aber wenn Flasche vor Fla steht, wird Flasche durch Fla ersetzt...
SEHR kritisch ist das bei Deinem HA: -SCHACHTABDECKUNG (25)-SCHACHTABDECKUNG (26)-SCHACHTABDECKUNG AUSSEN TV (27)-SCHACHTABDECKUNG TUER VO AU (28)-SCHACHTABDICHTUNG INNEN SS FESTST. (29)-SCHACHTABDICHTUNG TH (64)-SCHACHTABDICHTUNG TV (65)-ATMOSPHAERENLEIT (101)-KUEHLWASSERAUSGLEICHBEHAELT (108)-HANDBREMSBALG (113)-FANGHAKEN (129)-BLENDE SCHALTER (155)-HANDBREMSBOWDENZUG (162)-BREMSLICHTSCHALTER I REDESIGN (174)-BREMSLICHTSCHALTER II (175)-DACHANTENNE (178)-HA (232)-FILTERGEHAEUSE (242)-HALTELEISTE ABDECKUNG WINDLAUF (247)-WISCHANLAGE (254)-GEHAUSE
D.h., alle dortigen Begriffe vor Zeile 232 werden durch HA ersetzt!
Abhilfe: die Liste alphabetisch sortieren und so was wie das HA ganz nach oben setzen.
Das mal bis hierher, jetzt sehe ich mal, ob das Dictionary auf Anhieb läuft...
Schöne Grüße,
Michael

	C
29	Falsch
30	496

verwendete Formeln
Zelle	Formel	Bereich	N/A
C29	=C27=C28
C30	=SUMMEWENN([Bildschirm.xlsm]Statistik!$Q$44:$Q$54;"<" &HEUTE();[Bildschirm.xlsm]Statistik!$R$54)

Ähnliches Material suchen über Hilfstabelle

Forumthread: Ähnliches Material suchen über Hilfstabelle

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Ähnliches Material suchen über Hilfstabelle

Forumthread: Ähnliches Material suchen über Hilfstabelle

26 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread