[[20191027193856]]　『シートを任意で「入れ替え」したい』（nest1anest）　ページの最後に飛ぶ

『シートを任意で「入れ替え」したい』（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 ＞

よくわからないので現状のコードを提示されたほうがよいように思います。

とりあえず、"入替"という命令は無いと思いますので、指定した場所に移動（挿入）を行うという処理になろうかとは思いますが…

（もこな２） 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

コメント返信：

[ 一覧(最新更新順) ]

[[20191027193856]] 『シートを任意で「入れ替え」したい』（nest1anest） ページの最後に飛ぶ

[[20191027193856]]　『シートを任意で「入れ替え」したい』（nest1anest）　ページの最後に飛ぶ