|
こんばんは。
>選択した複数のシートを対象にソートするには、
>どうしたらいいんでしょうか?
>ActiveWindow.SelectedSheetsを使用すればできそうなのですが
>私のレベルだと、うまくいきません!^^;
並べ替えを行いたいシート群を選択した状態で以下のコードを実行して見てください。
但し、並べ替えの判断は、美貴さんが提示されたコードと同じです。
Sub select_sht_sort()
Dim g0 As Long, g1 As Long
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim ix1 As Long, ix2 As Long
Dim wk As Variant
ReDim col(1 To Windows(ThisWorkbook.Name).SelectedSheets.Count)
For g0 = 1 To Windows(ThisWorkbook.Name).SelectedSheets.Count
col(g0) = Windows(ThisWorkbook.Name).SelectedSheets(g0).Name
Next
For g0 = 1 To UBound(col()) - 1
Set sht1 = Worksheets(col(g0))
Set sht2 = Worksheets(col(g0 + 1))
ix1 = sht1.Index
ix2 = sht2.Index
If sht1.Name > sht2.Name Then
If UBound(col()) > ix2 + 1 Then
sht1.Move before:=Worksheets(ix2 + 1)
Else
sht1.Move after:=Worksheets(ix2)
End If
sht2.Move before:=Worksheets(ix1)
wk = col(g0)
col(g0) = col(g0 + 1)
col(g0 + 1) = wk
For g1 = g0 To 2 Step -1
Set sht1 = Worksheets(col(g1))
Set sht2 = Worksheets(col(g1 - 1))
ix1 = sht1.Index
ix2 = sht2.Index
If sht1.Name < sht2.Name Then
wk = col(g1)
col(g1) = col(g1 - 1)
col(g1 - 1) = wk
If UBound(col()) > ix1 + 1 Then
sht2.Move before:=Worksheets(ix1 + 1)
Else
sht2.Move after:=Worksheets(ix1)
End If
sht1.Move before:=Worksheets(ix2)
End If
Next
End If
Next
Worksheets(col()).Select
End Sub
↑は、バブルソートのアルゴリズムで作成しました。
|
|