[[20180305123635]]　『特定文字以降でシート並びソートかけたい』（しむ）　ページの最後に飛ぶ

『特定文字以降でシート並びソートかけたい』（しむ）

お世話になります
大変お手数おかけしますが
ご教示いただけたら幸いです

複数シート名の中に　　目　という文字が有ります

例　東京歯科目1K

その次の文字が数字の1から20まで入っています
この時この数字順に
シートを並び替える方法を教えていただけませんか

モーグのサンプルで試すと
10　11　12と　　二けた目から並び変わってします
なにとぞ　よろしくお願いいたします

http://www.moug.net/tech/exvba/0040060.html

Sub Sample2()

    Dim i As Long

    'ダミーシートを挿入する
    With Worksheets.Add
        'ワークシート名をセルに書き出す
        For i = 1 To Worksheets.Count
            .Cells(i, 1).Value = Worksheets(i).Name
        Next i

        'ワークシート名をソートする
        .Range("A1").CurrentRegion.Sort .Range("A1")

        'ワークシートの位置を並べ替える
        Worksheets(.Cells(1, 1).Value).Move Before:=Worksheets(1)
        For i = 2 To Worksheets.Count
            Worksheets(.Cells(i, 1).Value).Move After:=Worksheets(i - 1)
        Next i

        'ダミーシートを削除する
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
End Sub

＜使用 Excel：Excel2010、使用 OS：Windows10 ＞

 こんな感じで

 Sub test()
     Dim i As Long
     With CreateObject("System.Collections.SortedList")
         For i = 1 To Sheets.Count
             .Item(GetSortVal(Sheets(i).Name)) = Sheets(i).Name
         Next
         For i = .Count - 1 To 0 Step -1
             Sheets(.GetByIndex(i)).Move before:=Sheets(1)
         Next
     End With
 End Sub

 Function GetSortVal(ByVal txt As String) As String
     Dim i As Long, m As Object
     Static RegX As Object
     If RegX Is Nothing Then Set RegX = CreateObject("VBScript.RegExp")
     txt = StrConv(txt, 8)
     With RegX
         .Global = True
         .Pattern = "\d+"
         If .test(txt) Then
             For i = .Execute(txt).Count - 1 To 0 Step -1
                 Set m = .Execute(txt)(i)
                 txt = Application.Replace(txt, m.firstindex + 1, _
                       m.Length, Format$(m.Value, String(12, "0")))
             Next
         End If
     End With
     GetSortVal = txt
 End Function
（seiya） 2018/03/05(月) 13:34

被りましたが、数値だけ抜き出してB列にでもセットしておき、こっちをキーとして並び替えてはいかがでしょう？具体的には、現在Sortしている1行を、以下の2行に変えます。

        .Range("B1").Resize(Worksheets.Count, 1).Formula = "=IFERROR(VALUE(MID(A1,FIND(""目"",A1)+1,2)),VALUE(MID(A1,FIND(""目"",A1)+1,1)))"
        .Range("A1").CurrentRegion.Sort .Range("B1")
（???） 2018/03/05(月) 13:35

Sub main()

    Dim sht As Worksheet
    Dim i As Long
    For i = 20 To 1 Step -1
        For Each sht In Worksheets
            If Val(Mid(sht.Name, InStr(sht.Name, "目") + 1)) = i Then
                sht.Move Before:=Sheets(1)
                Exit For
            End If
        Next sht
    Next i
End Sub
（mm） 2018/03/05(月) 13:48

コメント返信：

[ 一覧(最新更新順) ]

[[20180305123635]] 『特定文字以降でシート並びソートかけたい』（しむ） ページの最後に飛ぶ

[[20180305123635]]　『特定文字以降でシート並びソートかけたい』（しむ）　ページの最後に飛ぶ