こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルマクロ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桁のグループに
分かれてソートされてしまいました。
どのようにしたらいいでしょうか?

投稿日時 - 2012-07-26 23:50:24

QNo.7612615

すぐに回答ほしいです

質問者が選んだベストアンサー

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

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

投稿日時 - 2012-07-27 00:55:29

お礼

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

投稿日時 - 2012-07-27 01:15:48

ANo.2

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.1

>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

投稿日時 - 2012-07-27 00:40:37

お礼

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

投稿日時 - 2012-07-27 01:16:33

あなたにオススメの質問