Excel / VBA: Wie kann ich Daten aus einer verbunden Zelle in separate Zeilen überführen und das pro Datensatz wiederholen?
Mir werden folgende Daten angeliefert (mit etwa 200 Anwender, die 2 bis 8 Rollen haben). Ich muss für jeden aktiven (Spalte B = Y) Anwender (Spalte A) die Rollen in separate Zeilen umwandeln, um die Daten weiterverarbeiten zu können.
Ausgangslage:
Zielbild:
Für Anwender A habe ich schon passende Formeln gefunden, wie ich die Daten aus Spalte C einzelne auslesen kann:
=LINKS(A2; FINDEN(ZEICHEN(10);A2)-1)
=TEIL($A2;FINDEN("#";WECHSELN($A2;ZEICHEN(10);"#";1))+1;FINDEN("#";WECHSELN($A2;ZEICHEN(10);"#";2))-FINDEN("#";WECHSELN($A2;ZEICHEN(10);"#";1))-1)
=TEIL($A2;FINDEN("#";WECHSELN($A2;ZEICHEN(10);"#";2))+1;FINDEN("#";WECHSELN($A2;ZEICHEN(10);"#";3))-FINDEN("#";WECHSELN($A2;ZEICHEN(10);"#";2))-1)
=RECHTS(A2;LÄNGE(A2)-FINDEN("#";WECHSELN(A2;ZEICHEN(10);"#";LÄNGE(A2)-LÄNGE(WECHSELN(A2;ZEICHEN(10);"")))))
Ich würde das gerne automatisieren und könnte mir vorstellen, dass dies mit VBA machbar ist. Leider kenn ich mich damit nur sehr begrenzt aus. Kann mir jemand bitte weiterhelfen?
1 Antwort
Ich hab vorgestern angefangen, einen VBA-Code dafür zu bauen, allerdings ist mir was dazwischen gekommen und mir ist jetzt erst wieder eingefallen, dass ich ja eine Antwort schreiben wollte.
Mir ist leider keine normale Excel-Formel eingefallen, mit der man das bewerkstelligen könnte, daher der Umweg über VBA.
Öffne den VBA-Editor (Alt+F11). Auf der linken Seite siehst du einen Projektexplorer, wo du einen Doppelklick auf die Tabelle machen musst, für die die Funktion eingefügt werden soll. Dann kannst du rechts diesen Code einfügen:
Public Sub Ungroup()
' Quellbereich definieren
Dim Quellbereich As Range
Set Quellbereich = Range("A2:C5")
' Zielbereich definieren
Dim Zielzeile As Integer
Zielzeile = 10
Dim Quellzeile As Variant
For Each Quellzeile In Quellbereich.Rows
' Nur die Zeilen nehmen, in denen Active = "Y" ist
If Quellzeile.Cells(2).Value = "Y" Then
Dim Rollen() As String
Rollen = Split(Quellzeile.Cells(3), Chr(10))
' Für jede Rolle eine neue Zeile generieren
Dim Rolle As Variant
For Each Rolle In Rollen
Cells(Zielzeile, 1) = Quellzeile.Cells(1)
Cells(Zielzeile, 2) = Quellzeile.Cells(2)
Cells(Zielzeile, 3) = Rolle
Zielzeile = Zielzeile + 1
Next Rolle
End If
Next Quellzeile
End Sub
Die Zeile mit "Zielzeile = 10" müsstest du so anpassen, wie es bei dir passt, damit die Daten unter die Originaltabelle geschrieben werden können. Alternativ könnte man den Code auch so umbauen, dass die Daten auf ein anderes Tabellenblatt geschrieben werden.
Wow! Das funktioniert 1-A und ist völlig ausreichend. Vielen herzlichen Dank, daCypher!!!