Matrix - Werte trennen und auflisten

Hallo Cracks
Ich hab eine "für mich" etwas komplexe Fragestellung:
Aktuelle Auflistung:
A B
=1 WertA
=2 WertB;WertC
=3 WertD
=4 WertF;WertG;WertH;WertI
Mein Zielauflistung:
A B
=1 WertA
=2 WertB
=2 WertC
=3 WertD
=4 WertF
=4 WertG
=4 WertH
=4 WertI
Das ganze natürlich dynamisch.
Die aktuellen Werte werden bereits durch eine Formel ermittelt:
Für A1:


="="&WENN(ZEILE(SHEET2!A1)> ANZAHL2(TABELLE[SPALTE1]); "";INDEX(SHEET2!A:A; KKLEINSTE(WENN((TABELLE[SPALTE1]0);
ZEILE(TABELLE[SPALTE1])); ZEILE(A1))))

Für B1:


="="&WENN(ZEILE(SHEET2!A1)> ANZAHL2(TABELLE[SPALTE1]); "";INDEX(SHEET2!B:B; KKLEINSTE(WENN((TABELLE[SPALTE1]0);
ZEILE(TABELLE[SPALTE1])); ZEILE(A1))))

Das zieh ich dann jeweils runter, aktuell sinds 2000 Quellwerte, werden aber ca. 20'000 werden.
Die Quelltabelle im Sheet2 sieht so aus:
A B
1 WertA
0 Wert Y
2 WertB;WertC
0 WertX
3 WertD
.....Wert Z
4 WertF;WertG;WertH;WertI
Ich benötige also die Matrix-Formel für das lückenlose Auflisten (in Spalte A und B) erweitert um das Erkennen der Semikolons, Split auf mehrere Zeilen und ergänzen mit dem jeweils identischen Wert aus Spalte A. Aktuell sind es maximal 4 Werte in der Spalte B, könnten aber 1-N sein.
Das Ganze ist Bestandteil einer Monster-Arbeitsmappe, hier halt stark vereinfacht dargestellt. Spalten und andere "Umwege" sind nicht so einfach zu implementieren.
Deshalb suche ich nach einer Lösung via Einzelformel.
VBA würd ich wohl hinkriegen, aber ich würds lieber nativ halten.
Mag da jemand mithelfen?
Danke und Grüsse
Ben

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Function Test(Quelle As Range) As Variant Dim arr Dim Erg Dim z As Long Dim zE As Long Dim TeilTexte1, TeilTexte2 Dim T Dim strA As String, strB As String Dim Zähler As Long arr = Intersect(Quelle, Quelle.Worksheet.UsedRange).Value For z = 1 To UBound(arr, 1) If arr(z, 1) 0 Then TeilTexte1 = Split(arr(z, 2), ";") For T = 0 To UBound(TeilTexte1) Zähler = Zähler + 1 strA = strA & ";" & arr(z, 1) strB = strB & ";" & TeilTexte1(T) Next End If Next ReDim Erg(1 To Zähler, 1 To 2) TeilTexte1 = Split(strA, ";") TeilTexte2 = Split(strB, ";") For z = 1 To Zähler If IsNumeric(TeilTexte1(z)) Then Erg(z, 1) = CDbl(TeilTexte1(z)) Else Erg(z, 1) = TeilTexte1(z) End If If IsNumeric(TeilTexte2(z)) Then Erg(z, 2) = CDbl(TeilTexte2(z)) Else Erg(z, 2) = TeilTexte2(z) End If Next Test = Erg End Function

Hey Daniel
Danke dir für den Code. Das wär auch ne nette Lösung, leider krieg ich aktuell grad nur #NAME! in allen Zellen. Ich krieg also die Funktion irgendwie nicht gegriffen. Stell aber gerade auch fest, das meine Company die Einstellung "Zugriff aufs VBA Projektmodell" deaktiviert hat.
Ich werde das also mal extern testen müssen. Würd mich aber nicht wundern, wenn ich die Funktion nicht verwenden darf. Wobei ich aber nicht weiss, obs da überhaupt einen Zusammenhang gibt?
Deine Schritte habe ich befolgt:
Code in den Allgemeinbereich von SHEET1.
Funktionsaufruf in A2, A2 - B2 markiert und Shift-+Enter.
Bringt mir A2-B20 gefüllt mit #NAME
Ich danke dir aber für den Input. Der Code sieht gut aus, wenn ichs schaffe die Funktion anzusteuern, wäre das sicher der QuickWin.
Grüsse
Ben

Beliebteste Forumthreads (12 Monate)

Matrix - Werte trennen und auflisten

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Matrix - Werte trennen und auflisten

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread