『シートを任意で「入れ替え」したい』(nest1anest) 下記のように4枚のシートを任意に入れ替えるボタンをフォーム上に作りました。 ボタン「1と2を入れ替える」  〃 「1と3を入れ替える」  〃 「1と4を入れ替える」  〃 「2と3を入れ替える」  〃 「2と4を入れ替える」  〃 「3と4を入れ替える」 しかし、任意で入れ替えるのは一度別のシートを作り、セルにそれぞれのシート名を入れておれを並び替えたのち、そのセルを参考にシートを実際に入れ替えるしかなさそうでした。 割と頻繁に使う予定のボタンですし、厳密には「任意の並び替え」ではなく、「任意の入れ替え」なので、もう少し簡単でさらっと押せるようなコードはないかと思っています。 各シート名はそれぞれ シート1「佐藤」 シート2「鈴木」 シート3「内藤」 シート4「吉田」 です。 Worksheets(1)に「鈴木」 Worksheets(2)に「佐藤」 と単純に指定できたらいいのですが・・・ < 使用 Excel:Excel2019、使用 OS:Windows10 > ---- よくわからないので現状のコードを提示されたほうがよいように思います。 とりあえず、"入替"という命令は無いと思いますので、指定した場所に移動(挿入)を行うという処理になろうかとは思いますが… (もこな2) 2019/10/27(日) 20:06 ---- 現状のコードはまだありません。 一応、検索して https://vbabeginner.net/vba%E3%81%A7%E3%82%B7%E3%83%BC%E3%83%88%E3%82%92%E4%BB%BB%E6%84%8F%E3%81%AE%E9%A0%86%E7%95%AA%E3%81%A7%E4%B8%A6%E3%81%B9%E6%9B%BF%E3%81%88%E3%82%8B/ というものを見つけたところでした。 が、指定した場所に移動ということであれば、 Moveメソッドというものがあり、 例えば ボタン「1と2を入れ替える」 であれば、 Worksheets("鈴木").Move Before := Worksheets(1) ボタン「1と3を入れ替える」 であれば、 Worksheets("内藤").Move Before := Worksheets(1) Worksheets("佐藤").Move Before := Worksheets(4) という感じで多くても2〜3行で済むようですね・・・(あってますでしょうか?) またなぜたった2行で済むことを 新規シートを作る →シート名を取得してセルに順番に代入 →セルを並び替える →並び替えた順序を参考にシートを実際に移動する →新規シートを削除する という長々としたコーディングが必要なのでしょうか? (nest1anest) 2019/10/27(日) 20:35 ---- 2つのシートの入れ替えではなく、多数のシートを一度で並べ替えることを目的にしているからでしょうね。 (べん) 2019/10/27(日) 21:24 ---- こういうことでしょうか? Sub mychg1and2() With Worksheets '1234 .Item(2).Move before:=.Item(1) '2134 End With End Sub Sub mychg1and3() With Worksheets '1234 .Item(1).Move before:=.Item(4) '2314 .Item(2).Move before:=.Item(1) '3214 End With End Sub Sub mychg1and4() With Worksheets '1234 .Item(1).Move after:=.Item(4) '2341 .Item(3).Move before:=.Item(1) '4231 End With End Sub Sub mychg2and3() With Worksheets '1234 .Item(3).Move before:=.Item(2) '1324 End With End Sub Sub mychg2and4() With Worksheets '1234 .Item(2).Move after:=.Item(4) '1342 .Item(3).Move before:=.Item(2) '1432 End With End Sub Sub mychg3and4() With Worksheets '1234 .Item(4).Move before:=.Item(3) '1243 End With End Sub (渡辺ひかる) 2019/10/28(月) 10:22 ---- Sub main() Dim dic As Object, k As Variant, i As Long, j As Long Set dic = CreateObject("Scripting.Dictionary") For i = 1 To Worksheets.Count For j = 1 To Worksheets.Count If dic(Worksheets(j).Name) = "" Then If MsgBox(i & "番目のシートは、" & Worksheets(j).Name & "でよろしいですか?", 36) = 6 Then dic(Worksheets(j).Name) = i Exit For End If End If Next j Next i For i = 1 To Worksheets.Count For Each k In dic If dic(k) = i Then Sheets(k).Move After:=Sheets(Worksheets.Count) Next k Next i End Sub (mm) 2019/10/28(月) 18:18 ---- サブプロシジャにすると簡単に使えそう。 Sub test() Call SheetChange("佐藤", "吉田") ' Call SheetChange(1, 4) 'こう指定してもOK End Sub Sub SheetChange(cw1 As Variant, cw2 As Variant) Dim iw1 As Long Dim iw2 As Long iw1 = Sheets(cw1).Index iw2 = Sheets(cw2).Index If iw1 < iw2 Then Sheets(cw1).Move before:=Sheets(cw2) Sheets(cw2).Move before:=Sheets(iw1) Else Sheets(cw1).Move after:=Sheets(cw2) Sheets(cw2).Move after:=Sheets(iw1) End If End Sub (???) 2019/10/29(火) 11:16