[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『シートの並べ替えで』（ひろくん）
いつもお世話になります
A1～A12までのシート名をならべかえたら
A10
A11
A12
A1
A2
.
.
.
みたいになるので
一桁の数字のシートに0をくわえて
A01
A02
みたいにしたいのですが
どういうマクロを書けばいいでしょうか
よろしくお願いします
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
シート名による並べ替えって、そもそもどうやっているんですか？
（γ） 2021/06/25(金) 23:13
Dim Sh As Worksheet
For Each Sh In Worksheets
aa = Format(Val(Replace(Sh.Name, "A", "")), "A00")
MsgBox aa
Next
（コロナで死ぬかワクチンで死ぬか・・・） 2021/06/26(土) 01:53
過去の反省も出来ていない。
（！） 2021/06/26(土) 02:03
Sub テキトー()
Dim i As Long
For i = 12 To 1 Step -1
Worksheets("A" & i).Move before:=Worksheets(1)
Next i
End Sub
（もこな２） 2021/06/26(土) 02:30
（もこな２） 2021/06/26(土) 02:43
（もこな２） 2021/06/28(月) 20:05
Worksheets("A" & i).Move before:=Worksheets(1)
をどう変えればB C D にも適用できるかわからないのです
（ひろくん） 2021/06/28(月) 20:27
【ステップ実行】 https://www.239-programing.com/excel-vba/basic/basic023.html http://plus1excel.web.fc2.com/learning/l301/t405.html
また、以下も知っておいて損は無いと思います。
【イミディエイトウィンドウ】 https://www.239-programing.com/excel-vba/basic/basic024.html https://excel-ubara.com/excelvba1/EXCELVBA486.html
【ローカルウィンドウ】 https://excel-ubara.com/excelvba4/EXCEL266.html http://excelvba.pc-users.net/fol8/8_2.html
【ブレークポイント】 https://www.239-programing.com/excel-vba/basic/basic022.html https://www.tipsfound.com/vba/01010
たとえば、
「A12」というシートなら↓ですし
Worksheets("A" & 12).Move before:=Worksheets(1)
「A3」というシートなら↓ですよね
Worksheets("A" & 3).Move before:=Worksheets(1)
本当にわかりませんか？
■２
ちょっと私が勘違いしていたかもです。
シートを並び替えるんじゃなくて（書き出した？）シート名を並び替えたいといった話なら関係なかったので忘れてください。
そのうえで、A1セルから順番に書き出してあるならB列に↓のような数式を書いてみてはどうでしょうか？
=LEFT(A1,1)&REPT("0",3-LEN(A1))&MID(A1,2,LEN(A1))
（もこな２） 2021/06/29(火) 07:40
>『シートの並べ替えで』 >シート名をならべかえたら
目的は、シートそのものの並べ替えなの？
それともシート名の一覧（シート上にある）を並べ替えるの？
>みたいになるので
どうやったらそうなった？
>みたいにしたい
ならば、その方法または作業手順を考えましょう。
>どういうマクロを書けばいいでしょうか
作業手順を考えるところから、プログラミングは始まってます。
サンプルを書いてもらって、
傾向と対策で一部を変更すればよいとお考えのようですが、
作業手順を日本語で説明できるようにならなければ、
マクロを書けるようにはならないですよ。
（書けるようになりたいと思ってないかもですが。。。）
（まっつわん） 2021/06/29(火) 15:25
（ひろくん） 2021/06/29(火) 21:14
A1R
A2R
というふうに
最後にRがついてました
見落としてました すいません
（ひろくん） 2021/06/30(水) 19:46
【シート自体】を並び替える (シートに書き出した)【シート名】を並び替える
どっちですか？
（もこな２ ） 2021/06/30(水) 19:55
「A12」というシートなら↓ですし
Worksheets("A" & 12).Move before:=Worksheets(1)
「A3」というシートなら↓ですよね
Worksheets("A" & 3).Move before:=Worksheets(1)
本当にわかりませんか？
（もこな２） 2021/06/30(水) 20:21
＞ちなみに最後にRがつくのですが
えっと。。。
「"A"」と「12」を合体させると「A12」になります。 「"A"」と「3」を合体させると「A3」になります。
では
「"A"」と「10」と「"R"」を合体させると何になりますか？
（もこな２） 2021/06/30(水) 21:29
Sub テキトー()
Dim i As Long
For i = 12 To 1 Step -1
Worksheets("A" & i & "R").Move before:=Worksheets(1)
Next i
End Sub
としましたがまたインデックスが有効範囲にありませんと出ます
変数のiには１２と出ています
（ひろくん） 2021/07/05(月) 20:09
# 船頭多くしての類だが、最初にコメントしたので、追加したい。
簡単な例で示すと、こういうことでしょ？ A2 A3 A4 A1 とシートが並んでいたとして、 これをA1,A2,A3,A4の順に並び変える方法は少なくも二つあります。
(1)優先度の高いものから順に、ワークシートの最後に移動する A2 A3 A4 A1 A1を最後に（結果的に動かない） A3 A4 A1 A2 A2を最後に移す A4 A1 A2 A3 A3を最後に A1 A2 A3 A4 A4を最後に または、 (2)優先度の低いものから順に、ワークシートの先頭に移動する A4 A2 A3 A1 A4を先頭に移す A3 A4 A2 A1 A3を先頭に A2 A3 A4 A1 A2を先頭に A1 A2 A3 A4 A1を先頭に
どちらかといえば、(1)が自然じゃないかな。
優先度順は、 ＞それぞれA１～１２ Ｂ１～１２ C１～１２ D１～１２まであります ということなら明確じゃないですか。 簡単に二重ループに落とし込めそうです。 （γ） 2021/07/06(火) 10:06
Sub リスト出力()
Dim buf(4) As String
Dim i As Long, c As Long
For i = 1 To Worksheets.Count
buf(c) = Worksheets(i).Name
If c = 4 Then
Debug.Print " " & Join(buf, vbTab)
c = 0
Erase buf
Else
c = c + 1
End If
Next i
If c > 0 Then Debug.Print " " & Join(buf, vbTab)
End Sub
■５
お返事がないので確認。↓はわかった（理解出来た）のですか？
「"A"」と「10」と「"R"」を合体させると何になりますか？ ＞どう変えればB C D にも適用できるかわからないのです
また、私も↓のお返事が気になりますのできちんと返答されては如何ですか？
＞シート名による並べ替えって、そもそもどうやっているんですか？
（もこな２） 2021/07/06(火) 11:13
Ａ２Ｒ Ａ１Ｒ Ａ４Ｒ Ａ７Ｒ Ａ９Ｒ Ａ10Ｒ Ａ11Ｒ Ｂ６Ｒ Ｂ８Ｒ Ｂ９Ｒ Ｂ10Ｒ Ｃ３Ｒ Ｃ６Ｒ Ｃ８Ｒ Ｃ10Ｒ Ｃ11Ｒ Ａ３Ｒ Ａ６Ｒ Ａ８Ｒ Ａ12Ｒ Ｂ２Ｒ Ｂ３Ｒ Ｂ４Ｒ Ｂ７Ｒ Ｂ11Ｒ Ｂ12Ｒ Ｃ１Ｒ Ｃ２Ｒ Ｃ４Ｒ Ｃ７Ｒ Ｃ９Ｒ Ｃ12Ｒ です ＞「"A"」と「10」と「"R"」を合体させると何になりますか？ A１０Rです ＞シート名による並べ替えって、そもそもどうやっているんですか？ 質問の意味がわからないのですが・・・ （ひろくん） 2021/07/06(火) 18:57
意味がわからないほど、おかしな質問ですか？
（γ） 2021/07/06(火) 19:16
（γ） 2021/07/06(火) 20:39
シート上で並べ替えると、こうはならず
＞A10
＞A11
＞A12
＞A1
＞A2
こうなるけどねえ？ 2007
A1
A10
A11
A12
A2
まるっきり作ってまらうために
なんか適当言ってないですかね？
（おかしい） 2021/07/07(水) 01:05
="A" &TEXT(MID(A1,2,10),"00")
（おかしい） 2021/07/07(水) 01:24
■６
＞＞「"A"」と「10」と「"R"」を合体させると何になりますか？
＞A１０Rです
ちがいます。「A10R」です。（全角と半角は別物です）
＞＞シート名による並べ替えって、そもそもどうやっているんですか？
＞質問の意味がわからないのですが・・・
冒頭に
＞A1～A12までのシート名をならべかえたら～みたいになるので
と仰っているので、皆さん【何らかの方法で並び替えた結果】を前提に質問されているだと解釈してるとおもいますが・・・・・（少なくとも私はそう解釈してました）
■７
今回のケースは割と難題ですね。ポイントは数字部分です。
「■６」で指摘のとおり、全角と半角は別物ですから、数"字"部分を合体させる前に、1文字であれば全角に変換、2文字であれば半角のままという条件分岐をする必要でてきます。
たとえば、こんな感じ
Sub 研究用()
Dim i As Long
For i = 1 To 12
If Len(i & "") = 1 Then
Debug.Print "Ａ" & StrConv(i, vbWide) & "Ｒ"
Else
Debug.Print "Ａ" & i & "Ｒ"
End If
Next
End Sub
■８
既にγさんから二重ループの指摘があるところですが、実際にはどのように並べたいのですか？
1) Ａ１Ｒ,Ａ２Ｒ,Ａ３Ｒ.....Ｂ１Ｒ,Ｂ２Ｒ,Ｂ３Ｒ... ↑のようにアルファベットごとに、1～12までならべたい
2) Ａ１Ｒ,Ｂ１Ｒ,Ｃ１Ｒ,Ｄ１Ｒ, Ａ２Ｒ,Ｂ２Ｒ,Ｃ２Ｒ,Ｄ２Ｒ....
↑のように数字ごとに、Ａ～Ｄまでならべたい
おそらく↑のどちらかだとは思いますが、どちらでも、あえて二重ループにしないというものありだとおもいます。
いずれにせよ、数日後のご自身が理解出来る方法を採られるとよいと思います。
（いままでの質問の傾向からみて、かえって混乱しそうに思うので、コメントしました。心配不要ということなら、お読み流しください)
このほか↓について、一向にお返事が頂けないのですが大丈夫ですか？
＞お返事がないので確認。↓はわかった（理解出来た）のですか？ ＞＞どう変えればB C D にも適用できるかわからないのです
（もこな２） 2021/07/07(水) 08:59
Ａ10Ｒ Ａ11Ｒ Ａ12Ｒ Ａ１Ｒ Ａ２Ｒ Ａ３Ｒ Ａ４Ｒ Ａ５Ｒ Ａ６Ｒ Ａ７Ｒ Ａ８Ｒ Ａ９Ｒ
この場合は、B列に↓のような数式をかけば、目的は達成できたとおもいます。
=IF(LEN(A1)=4,JIS(A1),LEFT(A1,1)&"０"&RIGHT(A1,2))
シート上に書き出して並び替えたシート名の順番に、シート自体を並び替える算段があったのだとすれば、こちらのアプローチのほうが理解しやすいかもしれません。
（もこな２） 2021/07/07(水) 18:02
■８ 既にγさんから二重ループの指摘があるところですが、実際にはどのように並べたいのですか？
1) Ａ１Ｒ,Ａ２Ｒ,Ａ３Ｒ.....Ｂ１Ｒ,Ｂ２Ｒ,Ｂ３Ｒ... ↑のようにアルファベットごとに、1～12までならべたい
2) Ａ１Ｒ,Ｂ１Ｒ,Ｃ１Ｒ,Ｄ１Ｒ, Ａ２Ｒ,Ｂ２Ｒ,Ｃ２Ｒ,Ｄ２Ｒ....
↑のように数字ごとに、Ａ～Ｄまでならべたい
1)です
（ひろくん） 2021/07/08(木) 19:08
何処で詰まってるのですか？
（もこな２ ） 2021/07/09(金) 06:49
こんなのでいいんじゃないですか？
Sub putSheetsInOrder()
Dim i As Long
Dim prefix
Dim WsCount As Long
WsCount = Worksheets.Count
For Each prefix In Array("A", "B", "C", "D")
For i = 1 To 12
On Error Resume Next
Worksheets(prefix & Format(i, "#0R")).Move after:=Worksheets(WsCount)
Worksheets(prefix & Format(i, "00R")).Move after:=Worksheets(WsCount)
On Error GoTo 0
Next i
Next prefix
End Sub
（半平太） 2021/07/11(日) 20:36
＞何か他に必要なんでしょうか
シート名に関する情報が不正確すぎます。
下のプログラムを実行して、イミディエイトウィンドウに打ち出されるシート名を コピーして、この掲示板に貼り付けてください。(解決策はそれを見た後で考えます）
こんな感じで出てくるはずです。 ↓ A1R A2R A3R A4R A5R A6R A6R A7R A8R A9R A10R A11R A12R A12R B1R B2R B3R B4R B5R B6R B6R B7R B8R B9R B10R B11R B12R B12R D12R
’貼り付けるマクロ
↓
Sub wsNamePrintInImeadiateWindow()
Dim i, ws
i = 0
For Each ws In ThisWorkbook.Worksheets
i = i + 1
If i >= 6 Then
i = 0
Debug.Print ws.Name & " ", vbCr
End If
Debug.Print ws.Name & " ";
Next
End Sub
（半平太） 2021/07/13(火) 21:26
Ａ10Ｒ Ａ11Ｒ Ｂ６Ｒ Ｂ８Ｒ Ｂ９Ｒ Ｂ10Ｒ Ｃ３Ｒ
Ｃ３Ｒ Ｃ６Ｒ Ｃ８Ｒ Ｃ10Ｒ Ｃ11Ｒ Ａ３Ｒ Ａ６Ｒ
Ａ６Ｒ Ａ８Ｒ Ａ12Ｒ Ｂ２Ｒ Ｂ３Ｒ Ｂ４Ｒ Ｂ７Ｒ
Ｂ７Ｒ Ｂ11Ｒ Ｂ12Ｒ Ｃ１Ｒ Ｃ２Ｒ Ｃ４Ｒ Ｃ７Ｒ
Ｃ７Ｒ Ｃ９Ｒ Ｃ12Ｒ Ａ２Ｒ Ａ１Ｒ Ａ４Ｒ Ａ７Ｒ Ａ９Ｒ Ａ10Ｒ
Ａ10Ｒ Ａ11Ｒ Ｂ６Ｒ Ｂ８Ｒ Ｂ９Ｒ Ｂ10Ｒ Ｃ３Ｒ
Ｃ３Ｒ Ｃ６Ｒ Ｃ８Ｒ Ｃ10Ｒ Ｃ11Ｒ Ａ３Ｒ Ａ６Ｒ
Ａ６Ｒ Ａ８Ｒ Ａ12Ｒ Ｂ２Ｒ Ｂ３Ｒ Ｂ４Ｒ Ｂ７Ｒ
Ｂ７Ｒ Ｂ11Ｒ Ｂ12Ｒ Ｃ１Ｒ Ｃ２Ｒ Ｃ４Ｒ Ｃ７Ｒ
Ｃ７Ｒ Ｃ９Ｒ Ｃ12Ｒ
と出ます
（ひろくん） 2021/07/13(火) 21:52
Ａ10Ｒ Ａ11Ｒ Ｂ６Ｒ Ｂ８Ｒ Ｂ９Ｒ Ｂ10Ｒ Ｃ３Ｒ
Ｃ３Ｒ Ｃ６Ｒ Ｃ８Ｒ Ｃ10Ｒ Ｃ11Ｒ Ａ３Ｒ Ａ６Ｒ
Ａ６Ｒ Ａ８Ｒ Ａ12Ｒ Ｂ２Ｒ Ｂ３Ｒ Ｂ４Ｒ Ｂ７Ｒ
Ｂ７Ｒ Ｂ11Ｒ Ｂ12Ｒ Ｃ１Ｒ Ｃ２Ｒ Ｃ４Ｒ Ｃ７Ｒ
Ｃ７Ｒ Ｃ９Ｒ Ｃ12Ｒ
です失礼しました
（ひろくん） 2021/07/13(火) 22:25
これでどうですか？
Sub putSheetsInOrder()
Dim sortedLst As Object
Dim i, NM, Temp
Dim ws As Worksheet
Dim wsCount As Long
Set sortedLst = CreateObject("System.Collections.SortedList")
For Each ws In ThisWorkbook.Worksheets
NM = ws.Name
Temp = Left(NM, 1) & Format(Mid(NM, 2, Len(NM) - 2), "00") & Right(NM, 1)
sortedLst.Add StrConv(Temp, vbNarrow), ws.Name
Next ws
wsCount = ThisWorkbook.Worksheets.Count
For i = 0 To sortedLst.Count - 1
Worksheets(sortedLst.GetByIndex(i)).Move after:=Worksheets(wsCount)
Next i
End Sub
（半平太） 2021/07/13(火) 22:49
＞シート名に関する情報が不正確すぎます。
またしょうもない回答者と怒られちゃいそうですが、シート名の状況は、「（ひろくん） 2021/07/06(火) 18:57」を見ればおわかりになるかと。
■10
結局ご自身で考えるのは放棄してしまわれたようで残念でなりません。
最後まで答えていただけませんでしたが、
＞どう変えればB C D にも適用できるかわからないのです
↑は、直ぐに理解できると思ったがゆえに”本当にわからないのか？と繰り返し確認していました。
"Ａ" & 10 & "Ｒ" ・・・・ 【Ａ10Ｒ】 なのですから、 "Ｂ" & 10 & "Ｒ" ・・・・ 【Ｂ10Ｒ】 になることはご理解いただけるのではないかと。
■11
半平太さんがやる気になられているようなので、私はこの辺で撤退しますが、「■７」をちゃんと研究していただいたなら、↓のようなコードができたとおもいますので参考に提示しておきます。
Sub ループを複数回にわける()
Dim i As Long
For i = 12 To 1 Step -1
If Len(i & "") = 1 Then
Worksheets("Ｄ" & StrConv(i, vbWide) & "Ｒ").Move before:=Worksheets(1)
Else
Worksheets("Ｄ" & i & "Ｒ").Move before:=Worksheets(1)
End If
Next i
For i = 12 To 1 Step -1
If Len(i & "") = 1 Then
Worksheets("Ｃ" & StrConv(i, vbWide) & "Ｒ").Move before:=Worksheets(1)
Else
Worksheets("Ｃ" & i & "Ｒ").Move before:=Worksheets(1)
End If
Next i
For i = 12 To 1 Step -1
If Len(i & "") = 1 Then
Worksheets("Ｂ" & StrConv(i, vbWide) & "Ｒ").Move before:=Worksheets(1)
Else
Worksheets("Ｂ" & i & "Ｒ").Move before:=Worksheets(1)
End If
Next i
For i = 12 To 1 Step -1
If Len(i & "") = 1 Then
Worksheets("Ａ" & StrConv(i, vbWide) & "Ｒ").Move before:=Worksheets(1)
Else
Worksheets("Ａ" & i & "Ｒ").Move before:=Worksheets(1)
End If
Next i
End Sub
'-------------------------------------------------------------
Sub 二重ループで一度に処理する()
Dim アルファベット As Variant
Dim 数字 As Long
For Each アルファベット In Array("Ａ", "Ｂ", "Ｃ", "Ｄ")
For 数字 = 12 To 1 Step -1
If Len(数字 & "") = 1 Then
Worksheets("Ａ" & StrConv(数字, vbWide) & "Ｒ").Move before:=Worksheets(1)
Else
Worksheets("Ａ" & 数字 & "Ｒ").Move before:=Worksheets(1)
End If
Next 数字
Next アルファベット
End Sub
※γさんがコメントされている(1)のようにしてもよかったのですが、 個人的には【それ以外】のシートが後ろに集まったほうが気持ちが良いと思うので、 どんどん前において後ろに押し出すようにしています。(好みの問題ですね）
（もこな２ ） 2021/07/13(火) 22:53
Sub 二重ループで一度に処理する_修正()
Dim アルファベット As Variant
Dim 数字 As Long
For Each アルファベット In Array("Ｄ", "Ｃ", "Ｂ", "Ａ")
For 数字 = 12 To 1 Step -1
If Len(数字 & "") = 1 Then
Worksheets(アルファベット & StrConv(数字, vbWide) & "Ｒ").Move before:=Worksheets(1)
Else
Worksheets(アルファベット & 数字 & "Ｒ").Move before:=Worksheets(1)
End If
Next 数字
Next アルファベット
End Sub
（もこな２ ） 2021/07/13(火) 22:57
Sub putSheetsInOrder()
Dim sortedLst As Object
Dim i, NM, Temp
Dim ws As Worksheet
Dim wsCount As Long
Set sortedLst = CreateObject("System.Collections.SortedList")
For Each ws In ThisWorkbook.Worksheets
NM = ws.Name
Temp = Left(NM, 1) & Format(Mid(NM, 2, Len(NM) - 2), "00") & Right(NM, 1)
sortedLst.Add StrConv(Temp, vbNarrow), ws.Name
Next ws
wsCount = ThisWorkbook.Worksheets.Count
For i = 0 To sortedLst.Count - 1
Worksheets(sortedLst.GetByIndex(i)).Move after:=Worksheets(wsCount) ここ
Next i
End Sub
ここというところが黄色くなり
インデックスが有効範囲にありませんと出ます
（ひろくん） 2021/07/13(火) 22:59
＞またしょうもない回答者と怒られちゃいそうですが もこな２さんにそんなこと言った覚えはないです。 その発言をしたときは「最近増えた回答者の中には」と言うニュアンスがあったはずですが。
＞＞シート名に関する情報が不正確すぎます。 ＞シート名の状況は、「（ひろくん） 2021/07/06(火) 18:57」を見ればおわかりになるかと。 一応読んではいますが、そんな危なっかしい命名ルールではいつかミスを犯します。 いや既に犯しているかも知れない。 「済みません。そうなってないシートがありました」なんてオチは珍しくもない。 なので、現物名を出してもらった次第です。
（半平太） 2021/07/13(火) 23:14
＞ここというところが黄色くなり ＞インデックスが有効範囲にありませんと出ます
あれれ？ そんなこと起こるはずがないと思うんですがねぇ・・
ちょっと、i、sortedLst.GetByIndex(i) 、WsCount がどうなっているかチェックして頂けませんか？
For i = 0 To sortedLst.Count - 1
Debug.Print i, sortedLst.GetByIndex(i) ,wsCount '←ーーーーーーーーーーーーーーー 一行挿入
Worksheets(sortedLst.GetByIndex(i)).Move after:=Worksheets(wsCount)
Next i
あと、イミディエイトウィンドウの最終はどう出ていますか？ こっちでは、こうなりますが、 ↓ 30 Ｃ11Ｒ 32 31 Ｃ12Ｒ 32
（半平太） 2021/07/13(火) 23:27
Sub putSheetsInOrder()
Dim sortedLst As Object
Dim i, NM, Temp
Dim ws As Worksheet
Dim wsCount As Long
Set sortedLst = CreateObject("System.Collections.SortedList")
For Each ws In ThisWorkbook.Worksheets
NM = ws.Name
Temp = Left(NM, 1) & Format(Mid(NM, 2, Len(NM) - 2), "00") & Right(NM, 1)
sortedLst.Add StrConv(Temp, vbNarrow), ws.Name
Next ws
wsCount = ThisWorkbook.Worksheets.Count
For i = 0 To sortedLst.Count - 1
Debug.Print i, sortedLst.GetByIndex(i), wsCount '←ーーーーーーーーーーーーーーー 一行挿入
Worksheets(sortedLst.GetByIndex(i)).Move after:=Worksheets(wsCount)
Next i
End Sub
ですよねぇ
同じところでエラーになります・・・・・・・・・・・・・
（ひろくん） 2021/07/14(水) 19:33
31 Ｃ12Ｒ 32 でした （ひろくん） 2021/07/14(水) 19:41
↓について【どのブックの】シートを【どのブックの】シートの後ろに移動させるのか、それぞれブックをきちんと指定すればよいです。
Worksheets(sortedLst.GetByIndex(i)).Move after:=Worksheets(wsCount)
（もこな２ ） 2021/07/14(水) 20:34
ActiveWorkbook.Worksheets(sortedLst.GetByIndex(i)).Move after:=ActiveWorkbook.Worksheets(wsCount) としましたがエラーになりました （ひろくん） 2021/07/14(水) 20:53
For Each ws In ThisWorkbook.Worksheets
~~~~~~~~~~~~
（ここも） 2021/07/14(水) 21:23
Sub putSheetsInOrder()
Dim sortedLst As Object
Dim i, NM, Temp
Dim ws As Worksheet
Dim wsCount As Long
Set sortedLst = CreateObject("System.Collections.SortedList")
For Each ws In ActiveWorkbook.Worksheets
NM = ws.Name
Temp = Left(NM, 1) & Format(Mid(NM, 2, Len(NM) - 2), "00") & Right(NM, 1)
sortedLst.Add StrConv(Temp, vbNarrow), ws.Name
Next ws
wsCount = ActiveWorkbook.Worksheets.Count
For i = 0 To sortedLst.Count - 1
Debug.Print i, sortedLst.GetByIndex(i), wsCount '←ーーーーーーーーーーーーーーー 一行挿入
ActiveWorkbook.Worksheets(sortedLst.GetByIndex(i)).Move after:=ActiveWorkbook.Worksheets(wsCount)
Next i
End Sub
Sub putSheetsInOrder()
Dim sortedLst As Object
Dim i, NM, Temp
Dim ws As Worksheet
Dim wsCount As Long
Set sortedLst = CreateObject("System.Collections.SortedList")
For Each ws In ActiveWorkbook.Worksheets
NM = ws.Name
Temp = Left(NM, 1) & Format(Mid(NM, 2, Len(NM) - 2), "00") & Right(NM, 1)
sortedLst.Add StrConv(Temp, vbNarrow), ws.Name
Next ws
wsCount = ActiveWorkbook.Worksheets.Count
For i = 0 To sortedLst.Count - 1
ActiveWorkbook.Worksheets(sortedLst.GetByIndex(i)).Move after:=ActiveWorkbook.Worksheets(wsCount)
Next i
End Sub
でできました皆さんありがとうございました
（ひろくん） 2021/07/14(水) 21:58
Sub 二重ループで一度に処理する_その2()
Dim i As Long, MySTR As Variant
On Error Resume Next
With ActiveWorkbook
For Each MySTR In Split("Ａ,Ｂ,Ｃ,Ｄ", ",")
For i = 1 To 12
.Worksheets(MySTR & i & "Ｒ").Move after:=.Worksheets(.Worksheets.Count)
.Worksheets(MySTR & StrConv(i, vbWide) & "Ｒ").Move after:=.Worksheets(.Worksheets.Count)
Next i
Next MySTR
End With
On Error GoTo 0
End Sub
'------------------------------------------------------------------------
Sub シート上で並び替えてから反映()
Dim i As Long
With Worksheets.Add
'シートに書き出し
For i = 1 To Worksheets.Count
.Cells(i, "A").Value = Worksheets(i).Name
'▼「■９」で提示の数式でよいはずだが「Formulaプロパティ」に代入するとNameエラーになっちゃうのでとりあえず．．
If Len(Worksheets(i).Name) = 3 Then
.Cells(i, "B").Value = Left(Worksheets(i).Name, 1) & "０" & Right(Worksheets(i).Name, 2)
Else
.Cells(i, "B").Value = StrConv(Worksheets(i).Name, vbWide)
End If
Next i
'シート上でシート名を並び替え
.Range("A:B").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo
'並び替えたシート名の順番にシート自体を並び替える
For i = 1 To Worksheets.Count
Worksheets(.Cells(i, "A").Value).Move after:=Worksheets(Worksheets.Count)
Next i
'作業用のシート削除する
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
End Sub
（もこな２ ） 2021/07/14(水) 23:28
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.