エクセルマクロVBAのシートのソート

質問

エクセルのシート名のソートをマクロでしたいのですが
例えば、aaa1,bbb3,bbb5,aaa12,aaa5,ccc1,vvv2,vvv10を
ソート後、bbb5,ccc1,vvv2,vvv10,aaa1,aaa5,aaa12のようにしたいです。
aaaのものだけをソートしてシート後ろに移動できればいいです。
その他はそのままで。
ところが、aaa12のように2桁の数字が入ると上手くソートできず困っています。
If Sheets(i).Name > Sheets(j).Name Thenのようなものでは、数字2桁と数字1桁のグループに
分かれてソートされてしまいました。
どのようにしたらいいでしょうか？

回答No.2

keithin · ベストアンサー

まぁ、チカラワザというよりは乱暴なだけですが：

sub macro2()
　dim i as long, u as long

　for i = 1 to worksheets.count
　　if left(worksheets(i).name, 3) = "aaa" then
　　　u = application.max(u, val(replace(worksheets(i).name, "aaa", "")))
　　end if
　next i

　on error resume next
　for i=1 to u
　　worksheets("aaa" & i).move after:=worksheets(worksheets.count)
　next i
end sub

お礼

ありがとうございます。
短いですね。すごいです。

回答No.1

keithin

＞aaaのものだけをソートしてシート後ろに移動できればいいです。

ざっくり作ってみただけなので読みにくいですが。

Sub macro1()
　Dim aaa()
　Dim i As Long, n As Long

　For i = 1 To Worksheets.Count
　　If Worksheets(i).Name Like "aaa*" Then
　　　ReDim Preserve aaa(n)
　　　aaa(n) = Val(Replace(Worksheets(i).Name, "aaa", ""))
　　　n = n + 1
　　End If
　Next i

　qsort aaa, 0, UBound(aaa)

　For i = 0 To UBound(aaa)
　　Worksheets("aaa" & aaa(i)).Move after:=Worksheets(Worksheets.Count)
　Next i

End Sub

Private Sub qsort(aaa, l, u)
　Dim cp As Long
　Dim ix1 As Long
　Dim ix2 As Long
　Dim buf1 As Long
　Dim buf2 As Long

　If l >= u Then Exit Sub
　cp = (l + u) \ 2
　buf1 = aaa(cp)
　aaa(cp) = aaa(l)
　ix2 = l
　ix1 = l + 1
　Do While ix1 <= u
　　If aaa(ix1) < buf1 Then
　　　ix2 = ix2 + 1
　　　buf2 = aaa(ix2)
　　　aaa(ix2) = aaa(ix1)
　　　aaa(ix1) = buf2
　　End If
　　ix1 = ix1 + 1
　Loop
　aaa(l) = aaa(ix2)
　aaa(ix2) = buf1
　Call qsort(aaa, l, ix2 - 1)
　Call qsort(aaa, ix2 + 1, u)
End Sub

お礼

ありがとうございます。
結構複雑になっちゃうんですね。