Sortering af celler i kolonne efter indholdets længde

Denne makro sorter celler i et område i en kolonne efter længden på cellernes indhold.

vil blive sorteret som

Det forudsættes at området, der skal sorteres har en overskrift og at der ikke forekommer tomme celler i området. Er der tomme celler, er det kun det sammenhængende område lige under overskriften, som sorteres. Et område behøver ikke at starte i række 1, men kan står hvor som helst i kolonnen. Når makroen startes, skal markøren stå i den celle, der indeholder overskriften. Står markøren i en anden celle, går makroen ud fra, at denne celle er overskrift og kun cellerne under den sorteres. Står markøren i en tom celle, vises en fejlmeddelelse og makroen afbrydes.

Sorteringsrækkefølgen er stigende. Har flere celler sammen længde, vil den indbyrdes rækkefølge af disse ikke blive ændret.

Sub SortLgd()
'Denne makro sorter cellerne i en kolonne efter længden på cellens indhold.
'Når makroen startes skal markøren stå i overskriften i den kolonne, der skal sorteres
'Har flere celler samme længde, bevares den indbyrdes rækkefølge af disse

'Slå skærmopdatering fra og erklær variable
    Application.ScreenUpdating = False
    Dim Start As String, Slut As String, Slut2 As String

'Test om markøren står i en tom celle
    If IsEmpty(ActiveCell) Then GoTo err

'Registrer adresse på startcelle og beregn slutcelle
    Start = ActiveCell.Address
    slut = ActiveCell.End(xlDown).Address
    slut2 = Range(slut).Offset(0, 1).Address

'Indsæt en midlertidig kolonne til højre for kolonnen, der ønskes sorteret
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

'I den nye kolonne indsættes længden på de celler, der skal sorteres
    For Each c In Range(Start & ":" & slut).Cells
        c.Offset(0, 1).Formula = Len(c.Value)
    Next c

'Vælg den første celle i den nye kolonne
    Range(Start).Offset(0, 1).Select

'Klargør til sortering efter den nye kolonne
'Der sorteres med korteste celle først
    ActiveWorkbook.Worksheets("Ark1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Ark1").Sort.SortFields.Add Key:=ActiveCell.Range("A1"), SortOn:=xlSortOnValues, _
      Order:=xlAscending, DataOption:=xlSortNormal

'Gennemfør sorteringen
    With ActiveWorkbook.Worksheets("Ark1").Sort
        .SetRange Range(Start & ":" & slut2)
        .Header = xlYes
        .Apply
    End With

'Slet den midlertidige kolonne
    ActiveCell.Columns("A:A").EntireColumn.Select
    Selection.Delete Shift:=xlToLeft

'Vælg overskriftscellen igen og slå skærmopdatering til
    Range(Start).Select
    Application.ScreenUpdating = True

    Exit Sub

'Fejlhåndtering/Slå skærmopdatering til efter fejl
err:
    MsgBox "Du skal stå i den første celle, der skal sorteres"
    Application.ScreenUpdating = True
End Sub
 

- Tilbage til makroer -
- Tilbage til Excel -