Clever-Excel-Forum

Seiten: 1 2

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!

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

viele Grüße aus Freigericht
Karl-Heinz

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))&" ";"; ";);"_";)

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)

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!

Manguun

volti

LCohen

Case

LCohen

Case

Manguun

volti

Manguun

Case