AW: Spalte A aufteilen
26.07.2011 14:22:55
Tino
Hallo,
hier mal ein Versuch
Option Explicit
Sub Aufteilen()
Dim oDic As Object, ArrayDaten(), ArrayAusgabe()
Dim n&, nn&, varItems
'Quelle
With Tabelle1
ArrayDaten = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
End With
Set oDic = CreateObject("Scripting.Dictionary")
For n = 1 To Ubound(ArrayDaten)
oDic(Replace(ArrayDaten(n, 1), " ", "")) = ArrayDaten(n, 1)
Next n
Redim Preserve ArrayAusgabe(1 To 10, 1 To oDic.Count / 10 + 1)
n = 1: nn = 1
For Each varItems In oDic.Items
ArrayAusgabe(n, nn) = varItems
n = n + 1
If n = 11 Then
n = 1
nn = nn + 1
End If
Next varItems
'Ausgabe
With Tabelle1
'Bereich leer machen für Daten
.Range("B2", .Cells(.Rows.Count, .Columns.Count)).ClearContents
With Range("B2").Resize(Ubound(ArrayAusgabe), Ubound(ArrayAusgabe, 2))
.Value = ArrayAusgabe
End With
End With
End Sub
Gruß Tino