String in einer Spalte suchen und löschen

	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	temID	ItemNo	ItemCO	Bestehende Wertrange	leer	leer	ItemProducer	Marke	Wert 1	Wert 2	Wert 3	Wert 4	Wert 5	Wert 6	Wert 7
2	732	10001	1546631	WERTA WERTB WERTC WERTD WERT1 WERT2 WERT3			Producer	Marke	WERTB	WERTC	WERT2	WERT4	WERT5	WERT6	WERT7
3	732	10001	1546631	WERTA WERTB WERTC WERTD WERT1 WERT2 WERT3			Producer	Marke	WERT6	WERT5	WERT4	WERT3	WERT2	WERT1	WERTA

temID

ItemNo

ItemCO

Bestehende Wertrange

leer

ItemProducer

Marke

Wert 1

Wert 2

Wert 3

Wert 4

Wert 5

Wert 6

Wert 7

732

10001

1546631

WERTA WERTB WERTC WERTD WERT1 WERT2 WERT3

Producer

Marke

WERTB

WERTC

WERT2

WERT4

WERT5

WERT6

WERT7

732

10001

1546631

WERTA WERTB WERTC WERTD WERT1 WERT2 WERT3

Producer

Marke

WERT6

WERT5

WERT4

WERT3

WERT2

WERT1

WERTA

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() With Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row).EntireRow .Columns(16).Formula = "="" ""&D2&"" """ .Columns(17).Resize(, 7).Formula = "=Substitute(P2,"" ""&I2&"" "","" "")" .Columns(24).Formula = "=Trim(W2)" .Columns(24).Copy .Columns(4).PasteSpecial xlPasteValues .Columns(16).Resize(, 9).ClearContents End With End Sub

…eine der Art
=WECHSELN(…WECHSELN(WECHSELN(" "&D2&" ";" "&I2&" ";" ");" "&J2&" ";" ");…;" "&O2&" "; " ")
aber da das 1. bis Spalte Z und noch dazu über alle Zeilen gehen soll, wäre in diesem Fall wohl eine Schritt-für-Schritt-Lösung oder UDF-Einsatz besser.
Für meine UDF-Fml gibt's keine Schritt-für-Schritt-Anleitung, denn das ist nur eine 1zellige MatrixFml, die alles erledigt. Erläutern kann man nur ihre Komponenten.
Inneres VJoin kombiniert die Inhalte des angegebenen Bereichs zu einem Text (mit Default-Verbinder Leerzeichen) ohne Wiederholungen gleicher Werte (-1). VSplit trennt diesen Text (auf den zuvor eingefügten Leerzeichen) wieder in EinzelElemente, die mit führenden und nachfolgenden Leerzeichen ergänzt wdn.
Dieser DatenfeldVektor wird dann in SplitVx als Trennzeichen benutzt, d.h., auf diesen Werten erfolgt eine Trennung des Textes in D2ff. Dadurch gehen diese Werte verloren. Abschließend verbindet VJoin das Übriggebliebene wieder zu einem Text, wobei GLÄTTEN dann evtl unnötige Leerzeichen beseitigt.
Die MatrixFmlForm ist erforderlich, damit auch immer alle erzeugten EinzelWerte mitgenommen wdn.
Luc :-?

…Kay,
und brauchst eigentlich keine Anleitung mehr. Allerdings könnte es ein vbLimits-Problem geben, denn du hattest zuvor nicht erwähnt, dass es sich um knapp 8000 Zeilen, also 7999*18 Zellen handelt. In solchen Fällen empfehlen die meisten Fml-Gurus auch für bestimmte komplexe XlFktt/-Fmln Hilfszellen.
Wenn deine Werte Zahlen sind, dürfte die Stellenzahl des einzelnen Werts keine große Rolle spielen, bei Texten deren Länge aber schon. Zwar kann man mit VBA fast beliebig lange Texte bilden, die entstehen hier auch temporär, aber ihre Übergabe von Fkt zu Fkt in der Fml könnte die Xl-Limitierungen überschreiten. Die ursprüngliche Fml hätte da sicher kein Problem. Außerdem geht es zu lasten der Berechnungsperformance, wenn in jeder Zelle von D der Teil I2:Z8000 wieder neu berechnet wdn muss. Das sollte in diesem Fall nur 1× gemacht und dann dieses Ergebnis immer wieder benutzt wdn.
Du kannst ja mal versuchen, ob du mit =VJoin(I$2:Z$8000;;-1) einen zusammengefassten Text aus den Inhalten aller relevanten Zellen in einer Hilfszelle erzeugen kannst, der jeden auftretenden Wert nur 1× enthält. Wenn der nicht zu lang wird, kannst du ihn dann in der restlichen MatrixFml verwenden: {=GLÄTTEN(VJoin(SplitVx(" "&D2&" ";" "&VSplit(hilfszelladresse)&" ")))}
Falls das nicht klappt, muss ich mir etwas Anderes einfallen lassen, denn bisher habe ich diese UDFs nur mit maximal 1000 EinzelTexten (unterschiedlicher Länge) getestet(ggf muss auch eine spezielle VBA-SubProzedur benutzt wdn, was übrigens auch eine Spezialität von Daniel wäre ;-]).
Ich hoffe, du hast auch die aktuelle Vs1.4 von VJoin in Gebrauch. Wenn während der Übergabe von UDF zu UDF ein Fehler in SteuerArgumenten auftritt, wird der ursprüngliche Text nämlich idR beibehalten.
Ich fürchte allerdings, dass das alles erst die Spitze des Eisbergs ist, denn es ist doch sehr ungewöhnlich, eine Tabelle derart aufzubauen. Möglicherweise sind die Texte in D auch viel länger, was eine geringere Redundanz in I:Z bedeuten könnte. Interessant wäre auch, ob die Daten in D primär sind oder irgendwie ermittelt wdn. Im letzteren Fall sollte man evtl besser dort ansetzen.
Vielleicht wäre es auch sinnvoller, die Werte in D zellenweise zu splitten, jeden einzelnen in der ganzen Matrix zu suchen und nur zu behalten, wenn er nicht gefunden wird. Dann würdest du auch mit nur 2 UDF auskommen:
{=VJoin(WENN(ZÄHLENWENN(I$2:Z$8000;VSplit(D2))>0;"";VSplit(D2));;-1)}
Diese MatrixFml solltest du viell zuerst ausprobieren, bevor du anderes versuchst!
Morrn, Luc :-?

Sub test() Dim dicLösch Dim a With ActiveSheet.UsedRange '--- Kompatibliltätenliste Trennzeichen am Anfang und End hinzu With .Columns(5) .Formula = "="" ""&RC[-1]&"" """ .Formula = .Value End With '--- Liste der zu löschenden Komatibilitäten ermitteln Set dicLösch = CreateObject("scripting.dictionary") For Each a In .Columns(9).Resize(.Rows.Count - 1, 18).Offset(1, 0).Value If a "" Then dicLösch(a) = 0 Next '--- Löschen With .Columns(5) For Each a In dicLösch.keys .Cells.Replace " " & a & " ", " ", xlPart Next End With '--- Trennzeichen am Anfang und ende wieder wegmachen With .Columns(4) .FormulaR1C1 = "=Trim(RC5)" .Formula = .Value End With .Columns(5).Offset(1, 0).ClearContents End With End Sub

Sub test1() Dim dicLösch Dim a Dim arr Dim txt As String Dim T Dim z As Long With ActiveSheet.UsedRange '--- Liste der zu löschenden Komatibilitäten ermitteln Set dicLösch = CreateObject("scripting.dictionary") For Each a In .Columns(9).Resize(.Rows.Count - 1, 18).Offset(1, 0).Value If a "" Then dicLösch(a) = 0 Next '--- Löschen With .Columns(4) arr = .Value For z = UBound(arr, 1) To 2 Step -1 txt = "" Application.StatusBar = "noch zu bearbeiten: " & z For Each T In Split(arr(z, 1), " ") If Not dicLösch.exists(T) Then txt = txt & " " & T Next arr(z, 1) = Mid(txt, 2) Next .Value = arr End With Application.StatusBar = False End With End Sub

Beliebteste Forumthreads (12 Monate)

String in einer Spalte suchen und löschen

31
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

333 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

String in einer Spalte suchen und löschen

31 Beiträge zum Forumthread Beiträge zu diesem Forumthread

333 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

31
Beiträge zum Forumthread

Beiträge zu diesem Forumthread