Solujen lajittelu

En keksinyt yhtäkkiä muuta kuin käyttää apusaraketta. Lajittelu menee oikein, jos lisäät kaikkien perään vaikka merkin "-". Välilyönti, numero tai desimaalierotin ei auta.

moduuliin...
Sub Sorttaa()
Dim Rng As Range
Dim Vika As Integer
Dim Solu As Range
Dim Numero As String
Dim Teksti As String
Dim a As Variant
Application.DisplayAlerts = False
On Error Resume Next
'Type:=8 sallii vain solualueen
Set Rng = Application.InputBox( _
Title:="Lajittelu", _
Prompt:="Valitse lajiteltava alue sarakkeesta", _
Type:=8)
On Error GoTo 0
If Rng Is Nothing Then Exit Sub
Rng.NumberFormat = "@"
Sheets.Add.Name = "Huuhaa"
Rng.Copy Worksheets("Huuhaa").Range("A1")
'pilkotaan solu numero ja tekstiosaan
For Each Solu In Worksheets("Huuhaa").Range("A1").Resize(Rng.Count)
' numero-osa(toimii vain, jos numero-osa on alussa
Numero = Val(Solu)
Solu.Offset(0, 1) = Numero
' tekstiosa
Teksti = Application.WorksheetFunction.Replace(Solu, 1, Len(Numero), "@")
a = Split(Teksti, "@")
' lisätään esim. a-kirjain, jotta saadaan lajiteltua pelkän luvun sisältävät solut oikein
Solu.Offset(0, 2) = "a" & a(1)
Next
' lajitellaan numero-osan ja sitten kirjainten mukaan
Worksheets("Huuhaa").Columns("A:C").Select
ActiveWorkbook.Worksheets("Huuhaa").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Huuhaa").Sort.SortFields.Add2 Key:=Range("B1:B8") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Huuhaa").Sort.SortFields.Add2 Key:=Range("C1:C8") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Huuhaa").Sort
.SetRange Range("A1:C8")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'muuta taulukon nimi sopivaksi
Worksheets("Huuhaa").Range("A1:A" & Rng.Count).Copy Worksheets("Taul1").Range(Rng.Address)
Worksheets("Huuhaa").Delete
Application.DisplayAlerts = True
End Sub

Keep EXCELing
@Kunde