[[20160901215402]]　『３箇所の並び替えをマクロで』（狭山）　ページの最後に飛ぶ

『３箇所の並び替えをマクロで』（狭山）

 先日は大変お世話になりまして有難うございました。
 以前はNHが(日にち)でしたが、エンディングが変なため、今後は（狭山）で投稿します。
 よろしくお願いいたします。

 以下の３箇所の範囲を昇順で並び替えをマクロ式で行いたいのですが。

 一箇所目 C11:M30の範囲を昇順で並び替え（優先順位はD列C列E列の順番で）					
			C	D	E	・・・・・	M

 タイトル行→	10	県名	月日	電話番号		
		・					
		・						
		30

 二箇所目 C36:M45の範囲を昇順で並び替え（優先順位はD列C列E列の順番で）

			C	D	E	・・・・・	M
 タイトル行→	35	県名	月日	電話番号		
		・					
		・						
		45

 三箇所目 C51:M60の範囲を昇順で並び替え（優先順位はD列C列E列の順番で）

			C	D	E	・・・・・	M
 タイトル行→	50	県名	月日	電話番号		
		・					
		・						
		60					
 よろしくお願いいたします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

まずは、一カ所目について、マクロ記録をとってみてますか？
それに手を入れればよいと思います。

（γ） 2016/09/01(木) 22:05

 ありがとうございました。
 マクロの記録を行う方法を調べていたため時間がかかりました。
 以下の構文で出来ましたがこんなに長いものなのでしょうか。
 また、シート名が実際のが入っていますが別のシートでもフリーに使用できる場合
 何を入れればよろしいのでしょうか。
 よろしくお願いいたします。

 Sub Macro2()
'
' Macro2 Macro
'

    ActiveWorkbook.Worksheets("詳細").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("詳細").Sort.SortFields.Add Key:=Range( _
        "D11:D30"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("詳細").Sort.SortFields.Add Key:=Range( _
        "C11:C30"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("詳細").Sort.SortFields.Add Key:=Range( _
        "E11:E30"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("詳細").Sort
        .SetRange Range("C10:M30")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=-9
End Sub

Sub Macro4()
'
' Macro4 Macro
'

    ActiveWorkbook.Worksheets("詳細").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("詳細").Sort.SortFields.Add Key:=Range( _
        "D36:D45"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("詳細").Sort.SortFields.Add Key:=Range( _
        "C36:C45"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("詳細").Sort.SortFields.Add Key:=Range( _
        "E36:E45"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("詳細").Sort
        .SetRange Range("C35:M45")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub Macro5()
'
' Macro5 Macro
'

    ActiveWorkbook.Worksheets("詳細").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("詳細").Sort.SortFields.Add Key:=Range( _
        "D51:D60"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("詳細").Sort.SortFields.Add Key:=Range( _
        "C51:C60"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("詳細").Sort.SortFields.Add Key:=Range( _
        "E51:E60"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("詳細").Sort
        .SetRange Range("C50:M60")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

（狭山） 2016/09/01(木) 22:41

 http://officetanaka.net/excel/vba/tips/tips148.htm
 を挙げておきます。

 Excel2007からSortオブジェクトが導入されています。
 それまでの方式（RangeオブジェクトのSortメソッド）も従来通り使えますから、
 ソート列が３つまでといった条件を満たすなら、従来の方式を使ってもOKでしょう。

 マクロ記録のコードは以下のように整理することも可能です。

 Sub test()
     Dim ws As Worksheet

     Set ws = Worksheets("詳細")
     With ws.Sort
         .SortFields.Clear
         .SortFields.Add Key:=ws.Range("D11"), SortOn:=xlSortOnValues, _
                         Order:=xlAscending, DataOption:=xlSortNormal
         .SortFields.Add Key:=ws.Range("C11"), SortOn:=xlSortOnValues, _
                         Order:=xlAscending, DataOption:=xlSortNormal
         .SortFields.Add Key:=ws.Range("E11"), SortOn:=xlSortOnValues, _
                         Order:=xlAscending, DataOption:=xlSortNormal
         .SetRange ws.Range("C10:M30")
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
 End Sub

 なお、引数を持つFunctionプロシージャにしたてて、
 何度も同一記述を避ける工夫もできるでしょう。
 検討してみてください。

 なお、シートの指定が煩わしかったら省略してもよいでしょう。
 その場合は、With ActiveSheet.Sort とします。
（γ） 2016/09/02(金) 06:48

 （γ）さん早速ありがとうございました。
 また、サイトまで感謝いたします。
 以下の構文でできました。

 しかし、指定が煩わしかったらWith ActiveSheet.Sort ですが
 どの構文を変更すればよいのでしょうか
 因みに Set ws = Worksheets("詳細")をSet ws =With ActiveSheet.Sort にしてみましたが
 構文エラーになってしまいました。

Sub 並び替え()

     Dim ws As Worksheet

     Set ws = Worksheets("詳細")
     With ws.Sort
         .SortFields.Clear
         .SortFields.Add Key:=ws.Range("D11"), SortOn:=xlSortOnValues, _
                         Order:=xlAscending, DataOption:=xlSortNormal
         .SortFields.Add Key:=ws.Range("C11"), SortOn:=xlSortOnValues, _
                         Order:=xlAscending, DataOption:=xlSortNormal
         .SortFields.Add Key:=ws.Range("E11"), SortOn:=xlSortOnValues, _
                         Order:=xlAscending, DataOption:=xlSortNormal
         .SetRange ws.Range("C10:M30")
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With

     Set ws = Worksheets("詳細")
     With ws.Sort
         .SortFields.Clear
         .SortFields.Add Key:=ws.Range("D36"), SortOn:=xlSortOnValues, _
                         Order:=xlAscending, DataOption:=xlSortNormal
         .SortFields.Add Key:=ws.Range("C36"), SortOn:=xlSortOnValues, _
                         Order:=xlAscending, DataOption:=xlSortNormal
         .SortFields.Add Key:=ws.Range("E36"), SortOn:=xlSortOnValues, _
                         Order:=xlAscending, DataOption:=xlSortNormal
         .SetRange ws.Range("C35:M45")
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With

     Set ws = Worksheets("詳細")
     With ws.Sort
         .SortFields.Clear
         .SortFields.Add Key:=ws.Range("D51"), SortOn:=xlSortOnValues, _
                         Order:=xlAscending, DataOption:=xlSortNormal
         .SortFields.Add Key:=ws.Range("C51"), SortOn:=xlSortOnValues, _
                         Order:=xlAscending, DataOption:=xlSortNormal
         .SortFields.Add Key:=ws.Range("E51"), SortOn:=xlSortOnValues, _
                         Order:=xlAscending, DataOption:=xlSortNormal
         .SetRange ws.Range("C50:M60")
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
 End Sub

（狭山） 2016/09/02(金) 09:32

 >因みに Set ws = Worksheets("詳細")をSet ws =With ActiveSheet.Sort にしてみましたが
 >構文エラーになってしまいました。

 そんな自己流はNGです。
 With句は勉強されたことがないようですね。
 この際ですから、テキストを引っ張り出して、よく確認してください。

 "詳細"シートがアクティブであることが確実であるなら、
 以下のように省略ができます。
 こんな書き方になるでしょう。（最初のブロックだけ示します。）

 Sub 並び替え()
      With ActiveSheet.Sort
          .SortFields.Clear
          .SortFields.Add Key:=Range("D11"), SortOn:=xlSortOnValues, _
                          Order:=xlAscending, DataOption:=xlSortNormal
          .SortFields.Add Key:=Range("C11"), SortOn:=xlSortOnValues, _
                          Order:=xlAscending, DataOption:=xlSortNormal
          .SortFields.Add Key:=Range("E11"), SortOn:=xlSortOnValues, _
                          Order:=xlAscending, DataOption:=xlSortNormal
          .SetRange Range("C10:M30")
          .Header = xlYes
          .MatchCase = False
          .Orientation = xlTopToBottom
          .SortMethod = xlPinYin
          .Apply
      End With
 End Sub

 私は、シートを指定したほうが間違いは少ないと思います。

■------------------

 ところで、3つのブロックの繰り返し記述を避けようとするなら、
 こんな書き方もできるでしょう。（一例です。色々な書き方があると思います）

 Sub test()

     mySort Worksheets("詳細").Range("C10:M30")
     mySort Worksheets("詳細").Range("C35:M45")
     mySort Worksheets("詳細").Range("C50:M60")
 End Sub

 Function mySort(rng As Range)
     Dim ws As Worksheet

     Set ws = rng.Parent
     With ws.Sort
         .SortFields.Clear
         .SortFields.Add Key:=rng.Cells(1, 2), SortOn:=xlSortOnValues, _
                         Order:=xlAscending, DataOption:=xlSortNormal
         .SortFields.Add Key:=rng.Cells(1, 1), SortOn:=xlSortOnValues, _
                         Order:=xlAscending, DataOption:=xlSortNormal
         .SortFields.Add Key:=rng.Cells(1, 3), SortOn:=xlSortOnValues, _
                         Order:=xlAscending, DataOption:=xlSortNormal
         .SetRange rng
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
 End Function

 まずは、少し冗長でも結果を出すことを優先したほうがよいかもしれません。
 慣れてきたら、上記のようなことにトライするのもよいでしょう。その時の参考に。

 # 自宅でしかアクセスしないので、勢い遅くなります。

（γ） 2016/09/02(金) 21:13

 （γ）さん。本当にありがとうございます。
 最後の繰り返しを避けるマクロで行いました。
 また、マクロボタンも作ってもました。
 今後も少しずつ勉強したいと思います。難しいと思いますが
 また、よろしくお願い致します。

（狭山） 2016/09/03(土) 11:58

コメント返信：

[ 一覧(最新更新順) ]

[[20160901215402]] 『３箇所の並び替えをマクロで』（狭山） ページの最後に飛ぶ

[[20160901215402]]　『３箇所の並び替えをマクロで』（狭山）　ページの最後に飛ぶ