AW: Informationen zusammentragen
26.02.2008 11:56:05
fcs
Hallo Tobias,
es ginge wahrscheinlich auch mit einem Formel-Ungetüm.
Hier mein Vorschlag als Makro-Lösung angepasst aus einer vorhandenen Variante
Gruß
Franz
Sub DatenUmgruppieren()
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Dim ZeileQ As Long, ZeileZ As Long, SpalteQ As Integer
Dim strName As String, Eintrag As Variant
Set wksQuelle = Worksheets("Tabelle1") 'Tabelle mit Ausgangsdaten
Set wksZiel = Worksheets("Tabelle2") 'Tabelle mit umgruppierten Daten
Application.ScreenUpdating = False
With wksZiel
'vorhandene Daten löschen
.UsedRange.ClearContents
'Zeilentitel eintragen
ZeileZ = 1
.Cells(ZeileZ, 1) = "Vorstands-Mitglieder"
.Cells(ZeileZ, 2) = "Funktionen"
.Rows(ZeileZ).Font.Bold = True
End With
With wksQuelle
'Zeilen in Ausgangsdaten abarbeiten
For ZeileQ = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Daten in Zeile einlesen
If .Cells(ZeileQ, 1).Value = "Resort-Helfer" Then
ZeileZ = ZeileZ + 2
wksZiel.Cells(ZeileZ, 1) = "Resort-Helfer"
wksZiel.Cells(ZeileZ, 2) = "Funktionen"
wksZiel.Rows(ZeileZ).Font.Bold = True
Else
If .Cells(ZeileQ, 1).Value "" Then
ZeileZ = ZeileZ + 1
strName = .Cells(ZeileQ, 1).Value
Eintrag = ""
For SpalteQ = 2 To .Cells(1, .Columns.Count).End(xlToLeft).Column
If .Cells(ZeileQ, SpalteQ) "" Then
If Eintrag = "" Then
Eintrag = .Cells(1, SpalteQ).Value & IIf(.Cells(2, SpalteQ).Value " ", _
.Cells(2, SpalteQ).Value, "") & " " & .Cells(ZeileQ, SpalteQ).Value
Else
Eintrag = Eintrag & ", " & .Cells(1, SpalteQ).Value _
& IIf(.Cells(2, SpalteQ).Value " ", .Cells(2, SpalteQ).Value, "") _
& " " & .Cells(ZeileQ, SpalteQ).Value
End If
End If
Next
wksZiel.Cells(ZeileZ, 1).Value = strName
wksZiel.Cells(ZeileZ, 2).Value = Eintrag
End If
End If
Next
End With
With wksZiel
'Spalten formatieren
.Range(.Columns(1), .Columns(2)).VerticalAlignment = xlTop
.Columns(1).AutoFit
.Columns(2).ColumnWidth = 80
.Columns(2).WrapText = True
End With
ende:
Application.ScreenUpdating = True
Set wksQuelle = Nothing: Set wksZiel = Nothing
End Sub