『セルの中の文字を並べ替えたい』（angel）

閲覧ありがとうございます

セルの中に、別のマクロで文字を入力しました
文字化けするので漢字で表記しますが、実際は○の中に1,2と入った記号です。

現状セルの中の文字が一三二、などと乱雑に並んでいます。
これを一二三と並べ替えたいのですが、どういった方法があるでしょうか。

そもそも入力するマクロの順番をいじって一二三と入るようにすべきなのですが、
後学のためもあり確認させていただきたいです。

文字は一から七まで、全て七文字入っているわけではなく、一つしかないセルや全く入ってないセルもあります。
故に文字数は0〜7、入っているセルは3,5,7,9,11の5行です。

お手数ですがご教授いただけたらと思います。



＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
----
 丸付数字はいくつか種類がありますが、種類は統一されてますか？

 (1) ←文字化けするので置き換えてます。
 ⓵
 ➀
（MK） 2022/11/11(金) 19:03:28
----
 正面突破するならこんな感じかな?   ...って道具の一例だけ提案 ^^;

    Rem １文字ずつ配列に分割
    Private Function SplitC(String1 As String) As Variant
        If Len(String1) = 0 Then Exit Function
        Dim b() As Byte, i As Long, Ary() As Variant, j As Long
        Dim s As String, bt() As Byte, f As Boolean
        b = String1
        ReDim Ary(0 To UBound(b))
        For i = 0 To UBound(b) Step 2
            If b(i + 1) >= &HD8& And b(i + 1) <= &HDB& Then
                f = True
                ReDim bt(0 To 3)
                bt(0) = b(i): bt(1) = b(i + 1)
            ElseIf f And b(i + 1) >= &HDC& And b(i + 1) <= &HDF& Then
                f = False
                bt(2) = b(i): bt(3) = b(i + 1): s = bt
                Ary(j) = s
                j = j + 1
            Else
                f = False
                ReDim bt(0 To 1)
                bt(0) = b(i): bt(1) = b(i + 1): s = bt
                Ary(j) = s
                j = j + 1
            End If
        Next
        ReDim Preserve Ary(0 To j - 1)
        SplitC = Ary
    End Function
    Rem いわゆる「挿入ソート」
    Private Sub InsertionSortBin(Target() As Variant, iFrom As Long, iTo As Long, Optional ByVal Desc As Boolean)
        Dim a As Long, b As Long
        Dim swp As Variant, Flg As Boolean
        For a = iFrom + 1 To iTo
            swp = Target(a)
            If Desc Then
                Flg = (Target(a - 1) < swp)
            Else
                Flg = (Target(a - 1) > swp)
            End If
            If Flg Then
                b = a
                Do
                    If Desc Then
                        If Target(b - 1) >= swp Then Exit Do
                    Else
                        If Target(b - 1) <= swp Then Exit Do
                    End If
                    Target(b) = Target(b - 1)
                    b = b - 1
                Loop While b > iFrom
                Target(b) = swp
            End If
        Next
    End Sub
    Rem 文字列を昇順に並べ替えて返す
    Function StrSorted(Str As String) As String
        If Len(Str) = 0 Then Exit Function
        Dim c()
        c = SplitC(Str)
        Call InsertionSortBin(c, LBound(c), UBound(c))
        StrSorted = Join(c, "")
    End Function

（白茶） 2022/11/11(金) 19:23:08
----
 イタタ...
 ごめんなさい。問題を勘違いした様です。盛大に... orz
 
 >セルの中に、別のマクロで文字を入力しました
 が
 「一セルの中に」に見えてしまったス。無視してください。
 
（白茶） 2022/11/11(金) 19:26:38
----
１セルだけですけど作ってみました。
一文字ずつワークシートに縦に書き出して、昇順で並べ替えてから再度結合します。
複数行だと、行列を入れ替えて貼り付けるとかの工夫が必要かもしれません。

 Sub test()
     Dim i As Long, n As Long, rng As Range
     n = Len(Range("A1"))
     For i = 1 To n
         Cells(i + 1, 1) = Mid(Range("A1"), i, 1)
     Next
     Range("A2").Resize(n).Sort key1:=Range("A2"), order1:=xlAscending
     Range("A1") = ""
     For Each rng In Range("A2").Resize(n)
         Range("A1") = Range("A1") & rng
     Next
     Range("A2").Resize(n) = ""
 End Sub
（フォーキー） 2022/11/11(金) 19:43:18
----
 既に回答が寄せられていますが、追加で。
 
 データはA列にあると仮定し、直ぐ右の列に書き出しています。（結果確認のためです）
 実情に合わせて適宜修正してください。下記の(*)部分等参考に。
 
 Sub test()
     Dim s As String
     Dim k As Long
     Dim r As Range
     
     For k = 3 To 11 Step 2
         Set r = Cells(k, "A")
         If Len(r.Text) > 0 Then
             r.Offset(, 1) = mySort(r.Text) 
             '' r = mySort(r.Text)      ' (*)
             
         End If
     Next
 End Sub
 
 Function mySort(s As String) As String
     Dim ary() As String
     Dim k&
     
     ReDim ary(1 To Len(s)) As String
     For k = 1 To Len(s)
         ary(k) = Mid(s, k, 1)
     Next
     Call バカソート(ary)
     mySort = Join(ary, "")
 End Function
 
 Sub バカソート(ByRef ary As Variant)
     Dim tmp As String
     Dim i As Long, j As Long
     For i = LBound(ary) To UBound(ary) - 1
         For j = i + 1 To UBound(ary)
             If ary(i) > ary(j) Then
                 tmp = ary(i)
                 ary(i) = ary(j)
                 ary(j) = tmp
             End If
         Next j
     Next i
 End Sub
 
 [備考]
 ソート名は、「アルゴリズムとデータ構造」（石畑清;岩波書店）という本のなかで
 使われている呼称であり、他意はありません。
 効率が良いわけではありませんが、なにせ簡便なので使われることも多いです。
 　
（γ） 2022/11/12(土) 08:30:01
----
バブルソート、こんな感じだ

5
4
1
3
2

5--比較
4--比較
1
3
2

4の方が小さいので、5と4を入れ替える

4--比較
5
1--比較
3
2

1の方が小さいので、4と1を入れ替える

1
5
4
3
2

これを1行目と最後まで繰り返す。

1
5--比較
4--比較
3
2

4の方が小さいので、5と4を入れ替える

1
4--比較
5
3--比較
2

3の方が小さいので、4と3を入れ替える

1
3--比較
5
4
2--比較

2の方が小さいので、3と3を入れ替える

1
2
5--比較
4--比較
3

4の方が小さいので、5と4を入れ替える

1
2
4--比較
5
3--比較

3の方が小さいので、4と3を入れ替える

1
2
3
5--比較
4--比較

4の方が小さいので、5と4を入れ替える

1
2
3
4
5
（バブルソート） 2022/11/12(土) 09:13:52
----
 念のため付記すると、バブルソートとバカソートは似ていますが、別のものです。
 　
（γ） 2022/11/12(土) 09:58:17
----
 丸数字の○１〜○７までしかセルに入ってないなら
 Function CSort(s As String) As String
   For i = &H8740 To &H8746
      If InStr(s, Chr(i)) Then CSort = CSort & Chr(i)
   Next
 End Function
 という感じでもいいんじゃないかと。
（´・ω・`） 2022/11/12(土) 23:58:12
----
パワークエリ勉強中です。
パワークエリならこんな感じでしょうか

（例）A1に「１２４５３」という感じで入っているものを
　　　「１２３４５」に変換するものです。

let
    ソース = Excel.CurrentWorkbook(){[Name="テーブル1"]}[Content],
    変更された型 = Table.TransformColumnTypes(ソース,{{"列1", type text}}),
    位置によって分割された列 = Table.SplitColumn(変更された型, "列1", Splitter.SplitTextByRepeatedLengths(1), {"列1.1", "列1.2", "列1.3", "列1.4", "列1.5"}),
    変更された型1 = Table.TransformColumnTypes(位置によって分割された列,{{"列1.1", type text}, {"列1.2", type text}, {"列1.3", type text}, {"列1.4", type text}, {"列1.5", type text}}),
    転置されたテーブル = Table.Transpose(変更された型1),
    並べ替えられた行 = Table.Sort(転置されたテーブル,{{"Column1", Order.Ascending}}),
    転置されたテーブル1 = Table.Transpose(並べ替えられた行),
    追加されたカスタム = Table.AddColumn(転置されたテーブル1, "カスタム", each [Column1]&[Column2]&[Column3]&[Column4]&[Column5]),
    削除された列 = Table.RemoveColumns(追加されたカスタム,{"Column1", "Column2", "Column3", "Column4", "Column5"})
in
    削除された列
（まっち） 2022/11/14(月) 13:48:43