Sortowanie znaków w ciągu
Dwa przykłady kodów VBA nadesłane przez Henryka Tomczyka.
Kod sortuje znaki w ciągu, wynik jest umieszczany w komórce na prawo od zawierającej sortowane znaki:
Sub Sortowanie_znaków_ciagu()
czy = MsgBox("Czy zaznaczono komórkę do sortowania znaków?" & Chr(13) _
& " (- wynik w komórce na prawo)", vbYesNo)
If czy = 7 Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Selection.Copy: Sheets.Add.Name = "aa" ' bo może brak miejsca w Arkusz1 ?
Range("A1").PasteSpecial Paste:=xlValues
Range("B1").Select
Range("C1") = "=LEN(""" & Range("A1") & """)"
dlug = Range("C1"): For a = 1 To dlug
Selection = "=MID(""" & Range("A1").Value & """," & a & ",1)"
Range("B1").Offset(a, 0).Select: Next a
Columns("B").Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("D1").Select: For a = 1 To dlug
Selection = Selection.Value & Range("B1").Offset(a - 1, 0).Value
Next a: Selection.Copy
Sheets("Arkusz1").Select
Selection.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlValues
Sheets("aa").Delete
Application.ScreenUpdating = True
End Sub
Drugi kod to funkcja użytkownika sortująca znaki wg tablicy:
Option Base 1
Public Function SortLiter(wyraz As String) As String
Dim TablicaLiter
Dim TablicaWyników(35) As String
Dim DłCiągu As Long
Dim i, j As Long
'poniższa kolejność znaków decyduje o sortowaniu - można ją zmienić !!!
TablicaLiter = Array("a", "ą", "b", "c", "ć", "d", "e", "ę", "f", "g", "h", "i", "j", "k", "l", _
"ł", "m", "n", "ń", "o", "ó", "p", "q", "r", "s", "ś", "t", "u", "v", "w", "x", "y", "z", "ź", "ż")
DłCiągu = Len(wyraz)
For i = 1 To DłCiągu
For j = 1 To 35
If LCase(Mid(wyraz, i, 1)) = TablicaLiter(j) Then
TablicaWyników(j) = TablicaWyników(j) & Mid(wyraz, i, 1)
Exit For
End If
Next j
Next i
For j = 1 To 35
SortLiter = SortLiter & TablicaWyników(j)
Next j
End Function