Textverketten mit Bedingung

[Manguun]

Hallo zusammen,

ich habe folgendes Problem: Ausgangslage ist eine simple Liste in der in Spalte A der Unternehmensname und in Spalte B die Abteilung steht. Es ist so, dass dasselbe Unternehmen häufiger vorkommen kann (es kann auch nur einmal vorkommen) und auch die Abteilung sich doppeln kann. Was ich gerne haben würde, wäre eine Liste, in der in Spalte A jedes Unternehmen nur einmal steht und in Spalte B dann in der jeweiligen Zelle daneben alle Abteilungen dieses Unternehmens. In den Anhang habe ich einen Beispieldatensatz gepackt, der hoffentlich deutlich macht, was die Ausgangslage ist und was ich mir am Ende erhoffe.

Ich habe schon etwas überlegt und etwas mit der Textverketten Option probiert, da allerdings noch keinen vernünftigen Weg gefunden, die Bedingungen einzufügen. Hoffentlich hat jemand von euch eine Idee, wie ich da rangehen könnte.

Vielen Dank!

[volti]

Hallo Maguun,

falls Du nichts gegen ein Makro hast, gäbe es folgende Idee zur Lösung Deines Problems:
Teste einfach mal, ob's in Deinem Sinne funktioniert.

Option Explicit

Sub Test()
 Dim iGefunden As Long, iZeile As Long, iOutZeile As Long
 
 Application.ScreenUpdating = False
 
 With Sheets("Tabelle1")
   iOutZeile = 4
   For iZeile = 4 To .Cells(.Rows.Count, "A").End(xlUp).Row
     On Error Resume Next
     iGefunden = 0
     iGefunden = Application.WorksheetFunction.Match( _
               .Cells(iZeile, "A").Value, .Range("E:E"), 0)
     If iGefunden > 0 Then
       .Cells(iGefunden, "F").Value = .Cells(iGefunden, "F").Value _
                              & ";" & .Cells(iZeile, "B").Value
     Else
       .Cells(iOutZeile, "E").Value = .Cells(iZeile, "A").Value
       .Cells(iOutZeile, "F").Value = .Cells(iZeile, "B").Value
       iOutZeile = iOutZeile + 1
     End If
   Next iZeile
 End With
 
 Application.ScreenUpdating = True

End Sub

[LCohen]

Da Du was von TEXTVERKETTEN sagtest (ab xl2019), gehe ich mal eben von XL365 aus:

E4: =EINDEUTIG(A4:A14)

F4: =WECHSELN(TEIL(TEXTVERKETTEN("; ";;B4:B14);
VERGLEICH(E4#;A4:A14;)*5-4;(
VERGLEICH(E4#;A4:A14)-
VERGLEICH(E4#;A4:A14;)+1)*5)&" ";";  ";)

Bedingungen für die Beschränkung auf die beiden Formeln, ohne sie kopieren zu müssen:
a) nach Spalte A ist sortiert
b) Spalte B hat exakte 3-Zeichen-Einträge
c) vor Zeile 14 werden neue Sätze eingefügt (damit man keinen umständlichen ANZAHL2()-Apparat rumschleppt)

Erläuterung:
TEXTVERKETTEN lässt sich leider nicht dynamisch bedingt verwenden. Daher verkette ich alles, und grenze dann mit TEIL und VERGLEICH ein.
____________________________________
Hier noch die Aufhebung von Bedingung b):
F4: =WECHSELN(WECHSELN(TEIL(TEXTVERKETTEN("; ";;B4:B14&WIEDERHOLEN("_";MAX(LÄNGE(B4:B14))-LÄNGE(B4:B14)));
VERGLEICH(E4#;A4:A14;)*(MAX(LÄNGE(B4:B14))+2)-(MAX(LÄNGE(B4:B14))+1);(
VERGLEICH(E4#;A4:A14)-
VERGLEICH(E4#;A4:A14;)+1)*(MAX(LÄNGE(B4:B14))+2))&" ";";  ";);"_";)

[00202]

Hallo, :19:

eine weitere Alternative: :21:
[attachment=33331]

[LCohen]

Alle 3 Bedingungen von #3 (s.o.) sind mit folgenden beiden Formeln aufgehoben:

E4: =SORTIEREN(EINDEUTIG(A4:INDEX(A:A;ANZAHL2(A:A)+2)))

F4:
=LET(
c;SORTIEREN(A4:INDEX(B:B;ANZAHL2(A:A)+2));
a;INDEX(c;;1);
b;INDEX(c;;2);
d;LÄNGE(b);
e;MAX(d)+2;k;"Das +2 ist die Länge des Verketters '; ' in TEXTVERKETTEN";
f;VERGLEICH(E4#;a;);l;"Speichere nichtbinären Vergleich für Speed";
WECHSELN(WECHSELN(TEIL(TEXTVERKETTEN("; ";;b&WIEDERHOLEN("_";MAX(d)-d));
f*e-e+1;(VERGLEICH(E4#;a)-f+1)*e)&" ";";  ";);"_";))

Man beachte die In-der-Formel-Kurzdoku (muss nicht sein!).

___________________
@ Case: 
1) Anscheinend Verknüpfungsrest "comburg" in der Datei, und 
2) keine Nachfrage, ob Makros aktiviert werden sollen (vermutlich meine eigene Dummheit)

[00202]

Hallo LCohen, :19:

uuppssss. - ja, da ist noch eine Verknüpfung auf ein Addin drin.

[Manguun]

Hallo zusammen,

vielen Dank für die vielen Vorschläge! Ich muss die Tage mal schauen, ob ich Zugriff auf eine 365 Excel-Version bekomme, da die Vorschläge mit der 16er oder 19er Version (glaube ich) alle nicht funktionieren oder? Makro ist auch etwas problematisch, da mein Rechner schon so mit der Größe des Datensatzes an seine Grenzen kommt und ich befürchte, dass mit aktivierten Makros gar nichts mehr geht.

Edit: LCohens erste Lösung funktioniert für mich in dee 19-Edition, vielen Dank!

[volti]

Hallo Manguun,

dass es Größenprobleme geben soll, weil da 500 Bytes Makros drin sind, kann ich nicht nachvollziehen.

Falls Du wirklich Probleme wegen der Größe einer Exceldatei haben solltest: Man kann seine Datei auch im xlsb-Format speichern. Dieses binäre Format ist in der Regel deutlich kleiner als xlsx und xlsm.

viele Grüße
Karl-Heinz

[Manguun]

Ich kenne mich mit Makros leider gar nicht aus, mir wurde nur mal geraten, Makros auszuschalten, damit der Datensatz flüssiger läuft. Danke für den Tipp mit dem Format, das werde ich mal ausprobieren.

[00202]

... mir wurde nur mal geraten, Makros auszuschalten, damit der Datensatz flüssiger läuft...

Hallo, :19:

vielen Dank für diesen Super-Gag. Ich konnte herzhaft lachen. Danke!!! :25: