AW: Zeilen konsolidieren per VBA
21.02.2008 23:36:54
fcs
Hallo Thomas,
mein Lösungsvorschlag. Tabellennamen muss du noch anpassen.
Gruß
Franz
Sub DatenUmgruppieren()
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Dim ZeileQ As Long, ZeileZ As Long, Zelle As Range
Dim Liste As String, KurzNAme As String, Bem As String
Set wksQuelle = Worksheets("Tab1") 'Tabelle mit Ausgangsdaten
Set wksZiel = Worksheets("Tab2") 'Tabelle mit umgruppierten Daten
With wksZiel
'vorhandene Daten löschen
.Range(.Columns(1), .Columns(3)).ClearContents
'Spaltentitel eintragen
.Cells(1, 1) = "Liste"
.Cells(1, 2) = "Kurz Name"
.Cells(1, 3) = "Bemerkung, Lose"
End With
With wksQuelle
'Zeilen in Ausgangsdaten abarbeiten
For ZeileQ = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Daten in Zeile einlesen
Liste = .Cells(ZeileQ, 1).Value
KurzNAme = .Cells(ZeileQ, 2).Value
Bem = .Cells(ZeileQ, 3).Value
With wksZiel
'Listen-Nr in Zieletabelle Apalte A suchen
Set Zelle = .Columns(1).Find(What:=Liste, LookIn:=xlValues, Lookat:=xlWhole)
'Daten in Zieltabelle eintragen
If Zelle Is Nothing Then 'Nummer noch nicht vorhandne
ZeileZ = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(ZeileZ, 1) = Liste
.Cells(ZeileZ, 2) = KurzNAme
.Cells(ZeileZ, 3) = Bem
Else 'Bemerkung, Los für vorhanden Nummer ergänzen
ZeileZ = Zelle.Row
.Cells(ZeileZ, 3) = .Cells(ZeileZ, 3) & ", " & Bem
End If
End With
Next
End With
With wksZiel
.Activate
'Daten nach Listen-Numer sortieren
.Range(.Columns(1), .Columns(3)).Sort _
Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlYes
End With
Set Zelle = Nothing: Set wksQuelle = Nothing: Set wksZiel = Nothing
End Sub