記述を簡略化させたい

質問

お世話になります。
下記の記述をスマートにさせたいのですが、ご教示お願いします。

　　　　　　　　記

Sub 優先順位()

Range("A16:Y25").Select
Selection.Sort Key1:=Range("Y16"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal

Range("A43:Y52").Select
Selection.Sort Key1:=Range("Y43"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal

Range("A70:Y79").Select
Selection.Sort Key1:=Range("Y70"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal

Range("A97:Y106").Select
Selection.Sort Key1:=Range("Y97"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Range("A16").Select

End Sub

回答No.1

KenKen_SP · ベストアンサー

こんにちは。

ソートキーは Y 列固定なら

Sub 優先順位()
　　Dim r As Range
　　For Each r In Range("A16:Y25,A43:Y52,A70:Y79,A97:Y106").Areas
　　　　r.Sort Key1:=Columns("Y"), Order1:=xlAscending, Header:=xlGuess
　　Next
End Sub

ソートキーを各ソート範囲の最終列と動的に指定するなら

r.Sort Key1:=r.Columns(r.Columns.Count), Order1:=xlAscending, Header:=xlGuess

に書き換えて下さい。

お礼

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

回答No.2

khazad-lefty

たとえばこんな感じで共通処理を外に出すとか

Sub任意ソート(RangeA as string ,RangeB as String)
Range(RangeA ).Select
Selection.Sort Key1:=Range(RangeB ), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
end sub

Sub 優先順位()

call Sub任意ソート("A16:Y25","Y16")
call Sub任意ソート("A43:Y52","Y43")
call Sub任意ソート("A70:Y79","Y70")
call Sub任意ソート(A97:Y106","Y97")
Range("A16").Select

End Sub

お礼

ありがとうございます。
そうか、外に出すですか。
なるほど、すっきりしますね。