per VBA-Makro
27.06.2004 02:15:53
Hans
Hallo Alex
Ich sehe nur die Lösung mit einem VBA-Makro, da Sortieren mit Formeln schwierig und ein Umbrechen in mehrere Spalten fast unmöglich ist.
Fülle den folgenden Code ins Code-Blatt der Tabelle "Buchstaben" ein. Das Makro kommt jedes Mal zum Zug, wenn du eine Zelle änderst. Doppelgänger wie "REM" werden nur einmal aufgelistet. Wenn du sie zweimal willst, dann heisst es colCountries.Add rngCell statt colCountries.Add rngCell, CStr(rngCell).
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim colCountries As New Collection
Dim rngCell As Range
Const lngMAXROWS = 19
Const lngMAXCOLS = 7
Dim i As Long, j As Long
On Error Resume Next
For Each rngCell In [Buchstaben!A1].Resize([Buchstaben!A1].SpecialCells(xlLastCell).Row, 1)
'fülle Werte in Collection ab (keine Duplikate
If Not IsEmpty(rngCell) Then colCountries.Add rngCell, CStr(rngCell)
Next
On Error GoTo 0
Set colCountries = SortColl(colCountries) 'sortiere die Collection
'lösche die Tabelle
[Tabelle!A1].Resize(lngMAXROWS, lngMAXCOLS).ClearContents
For i = 1 To colCountries.Count 'schreibe den Collection in die Tabelle
Worksheets![Tabelle].Cells((i - 1) Mod lngMAXROWS + 1, (i - 1) \ lngMAXROWS + 1) = colCountries(i)
Next
End Sub
Private Function SortColl(colRaw As Collection) As Collection
'01-00 Sorts elements in a collection as text (a = A, 10 < 2, _ < 0)
Dim i As Long, j As Long
Dim varSwap1, varSwap2
For i = 1 To colRaw.Count - 1 'sort the collection
For j = i + 1 To colRaw.Count
If colRaw(i) > colRaw(j) Then
varSwap1 = colRaw(i)
varSwap2 = colRaw(j)
colRaw.Add varSwap1, before:=j
colRaw.Add varSwap2, before:=i
colRaw.Remove i + 1
colRaw.Remove j + 1
End If
Next
Next
Set SortColl = colRaw
End Function
Gruss
Hans T.