AW: Liste umsortieren
03.01.2007 13:03:39
fcs
Hallo Gert,
bei einer sehr langen Liste (mehr als 255 Namen) gibt es ein Problem mit der maximalen Spaltenzahl.
Hier mal zwei Makros, mit denen man die Daten umgruppieren kann. Entweder in 3 Spalten oder in 3 Zeilen.
Sub DatenUmgruppieren2()
'Gruppiert Adressen in 3 Spalten um
Dim wks1 As Worksheet, wks2 As Worksheet, text As Variant
Dim Zeile1 As Long, Zeile2 As Long, I As Integer, J As Long
Set wks1 = ActiveWorkbook.Sheets("Tabelle1") 'Quelltabelle
Set wks2 = ActiveWorkbook.Sheets("Tabelle2") 'Zieltabelle
Zeile2 = 1
With wks2
.Cells.ClearContents 'Daten in Zieltabelle löschen
'Spaltentitel eintragen
.Cells(Zeile2, 1) = wks1.Cells(1, "A").Value
.Cells(Zeile2, 2) = wks1.Cells(2, "A").Value
.Cells(Zeile2, 3) = wks1.Cells(3, "A").Value
'Daten übertragen aus Spalte B
For J = 1 To wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row
Zeile2 = Zeile2 + 1
For I = 1 To 3
Zeile1 = Zeile1 + 1
.Cells(Zeile2, I).Value = wks1.Cells(Zeile1, "B").Value
Next
Next
End With
End Sub
Sub DatenUmgruppieren1()
'Gruppiert Adressen in 3 Zeilen um
Dim wks1 As Worksheet, wks2 As Worksheet, text As Variant
Dim Zeile1 As Long, Spalte2 As Long, I As Integer, Zeile2 As Long, J As Long
Set wks1 = ActiveWorkbook.Sheets("Tabelle1") 'Quelltabelle
Set wks2 = ActiveWorkbook.Sheets("Tabelle2") 'Zieltabelle
Spalte2 = 1
Zeile2 = 0
With wks2
.Cells.ClearContents 'Daten in Zieltabelle löschen
'Zeielntitel eintragen
.Cells(1, Spalte2) = wks1.Cells(1, "A").Value
.Cells(2, Spalte2) = wks1.Cells(2, "A").Value
.Cells(3, Spalte2) = wks1.Cells(3, "A").Value
'Daten übertragen aus Spalte B
For J = 1 To wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row
If Spalte2 = wks2.Columns.Count Then
MsgBox "Alle Spalten der Tabelle sind ausgefüllt. 4 Zeilen unterhalb geht es weiter"
Spalte2 = 1
Zeile2 = Zeile2 + 4
.Cells(Zeile2 + 1, Spalte2) = wks1.Cells(1, "A").Value
.Cells(Zeile2 + 2, Spalte2) = wks1.Cells(2, "A").Value
.Cells(Zeile2 + 3, Spalte2) = wks1.Cells(3, "A").Value
End If
Spalte2 = Spalte2 + 1
For I = 1 To 3
Zeile1 = Zeile1 + 1
.Cells(Zeile2 + I, Spalte2).Value = wks1.Cells(Zeile1, "B").Value
Next
Next
End With
End Sub
Die Namen der Tabellen muss du ggf. anpassen.
Gruß
Franz
P.S. Formellösung mit Funktion INDIREKT und kompliziertem umrechnen von Zeilen und Spalten ginge wohl auch, dannach steht mir aber z.Zt. nicht der Sinn.