Sorteren in een cel

Inleiding

In Excel cellen sorteren is een koud kunstje. Selecteer eerst alle cellen van je bereik, ook meerdere kolommen kan je tegelijk sorteren. Als je slechts 1 kolom wil sorteren, druk dan op het A-Z icoontje of het Z-A icoontje in de Standaard werkbalk. Het is zo simpel als dat. Wil je (op) meerdere kolommen sorteren, kies dan voor Data > Sorteren. Duid de sorteervolgorde en de manier van sorteren (oplopend of aflopend) aan. En als je mijn Excel-tips al eens gelezen hebt, dan weet je ook dat sorteren op rijen ook kan.

Maar het wordt tricky als we de inhoud binnen 1 cel willen sorteren, alfabetisch. Je kan met name meerdere lijnen in 1 cel gebruiken door aan het einde van een lijn Alt + Enter te doen (linker Alt-toets dus op het klavier). Deze code is grotendeels overgenomen uit mijn antwoord op deze vraag op Helpmij. Zo ziet het er uit met een dom voorbeeldje:

VBA-code

Sub SorterenInEenCel()
' Wim Gielis ' http://www.wimgielis.com
''''' ' Module to sort multiple lines in one cell alphabetically ' 13/04/07 '''''
Dim l As Long Dim arrSubParts As Variant Dim rngSort As Range Dim rng As Range Dim strToSort As String Dim str1 As String, str2 As String Dim lLoop As Long, lLoop2 As Long Set rngSort = Application.InputBox("Duid de te sorteren cellen aan.", "Cellenbereik", Selection.Address, Type:=8) If rngSort Is Nothing Then Exit Sub Application.ScreenUpdating = False For Each rng In rngSort strToSort = rng.Value If strToSort <> "" Then Do While InStr(strToSort, Chr(10) & Chr(10)) > 0 strToSort = Replace(strToSort, Chr(10) & Chr(10), Chr(10)) Loop Do While Left(strToSort, 1) = Chr(10) strToSort = Right(strToSort, Len(strToSort) - 1) Loop Do While Right(strToSort, 1) = Chr(10) strToSort = Left(strToSort, Len(strToSort) - 1) Loop arrSubParts = Split(strToSort, Chr(10)) For lLoop = 0 To UBound(arrSubParts) For lLoop2 = lLoop To UBound(arrSubParts) If UCase(arrSubParts(lLoop2)) < UCase(arrSubParts(lLoop)) Then str1 = arrSubParts(lLoop) str2 = arrSubParts(lLoop2) arrSubParts(lLoop) = str2 arrSubParts(lLoop2) = str1 End If Next lLoop2 Next lLoop rng.Value = Join(arrSubParts, Chr(10)) End If Next rng Application.ScreenUpdating = True
End Sub

Ook deze code is vanuit didactisch oogpunt enorm interessant voor zij die VBA onder de knie willen krijgen. Bekijk op een druilerige zaterdagnamiddag zeker eens in detail de code hierboven. Veel plezier met de code.




Over Wim

Wim Gielis is Business Intelligence consultant en Excel expert

Andere links