[[20161217161056]]　『[20161208210653]並べ替えを自動化させた関連』（だいちゃん）　ページの最後に飛ぶ

『[20161208210653]並べ替えを自動化させた関連』（だいちゃん）

[20161208210653]関連の継続質問です。

質問?@
Sub SortTest2()は、H列(名前)とD列(日付)で並び替えをするマクロなのですが、このH列を別シートのB3:B12から参照させてその順番どおりに並び替えをさせたいと思いますが、どのような修正が必要でしょうか？

質問?A
このマクロを設定しているシートはもちろん、それ以外のシートにもこのマクロのボタンを作って、別シートのボタンを押しても移動させないようにしたいとのですが、どのような修正が必要でしょうか？

以上、併せてご教示願います。よろしくお願いします。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 参照しやすいようにリンクを貼っておきます。

[[20161208210653]]　『並べ替えを自動化させたい』（だいちゃん）

 で、今回の２つのテーマですけど、元スレの　（だいちゃん） 2016/12/13(火) 07:46　でアップされた
 SortTest2 をべースにするということでいいのですね？

 本来は、元シートから指定条件で抜出し、それを並び替えるというもので、私からは Sample2 としてアップしていますが
 そちらではなく、この SortTest2でやっている並び替えだけということですね？

 >>このH列を別シートのB3:B12から参照させてその順番どおりに並び替えをさせたい

 B3:B12 には、たとえば、どのようなものが、どのように入っているのでしょうか？
 また、そこに指定しただけの並び順にするのですか？　それとも、それに加えて D列も並び順に加えるのですか？

 >>別シートのボタンを押しても移動させない

 これについては、何度も、だいちゃんさんが、シートをアクティベートするコードをアップしていて
 まず、それを出発にして、コードが完成したら、最後に、対応しましょうと申し上げていましたよね？

 で、元スレ、最後のほうですけど、私から Sample1,Sample2 を　アップしています。
 これは試してみましたか？（少なくともコードを眺めてみましたか？）
 これらのマクロでは、どのシートにボタンがあろうと、一切のシート移動はしていません。

（β） 2016/12/17(土) 16:54

SortTest2 をべースにするということでいいのですね？はい、そう考えています。

B3:B12 には、たとえば、どのようなものが、どのように入っているのでしょうか？

 また、そこに指定しただけの並び順にするのですか？　それとも、それに加えて D列も並び順に加えるのですか？
B列には名前が入っています。五十音順ではなく役職別ですので、番号の若い順に並び替えさせたいです。
また、それに加えてD列も並び替えさせたいです。

別シートのボタンを押しても移動させない

 これについては、何度も、だいちゃんさんが、シートをアクティベートするコードをアップしていて
 まず、それを出発にして、コードが完成したら、最後に、対応しましょうと申し上げていましたよね？
はい、お願いします。

で、元スレ、最後のほうですけど、私から Sample1,Sample2 を　アップしています。

 これは試してみましたか？（少なくともコードを眺めてみましたか？）
 これらのマクロでは、どのシートにボタンがあろうと、一切のシート移動はしていません。

まず、元スレでご教示頂いたものを確認したところ、コンパイルエラーが表示されてしまいます。
以下のように修正していますが、正しいでしょうか？

 Sub Sample1()
    Dim r As Range
    Dim sh As Worksheet

    Set sh = Sheets("データ入力")

    sh.Unprotect "00001"

    Set r = sh.Range("C5", sh.Range("C" & Rows.Count).End(xlUp)).EntireRow.Columns("C:Y")
    r.Sort Key1:=sh.Range("D5"), order1:=xlAscending, Key2:=sh.Range("G5"), order2:=xlAscending, Header:=xlYes

    ReProtect sh, "00001"    '★

 End Sub

 Sub Sample2()
    Dim mR As Range
    Dim cR As Range
    Dim shF As Worksheet
    Dim shT As Worksheet
    Dim r As Range

    Application.ScreenUpdating = False

    Set shF = Sheets("データ入力")  '元シート
    Set shT = Sheets("抽出")      '★展開シート

    shF.Unprotect "00001"    '★
    shT.Unprotect "00001"    '★

    Set r = shF.Range("C5", shF.Range("C" & Rows.Count).End(xlUp)).EntireRow.Columns("C:Y")
    Set mR = shF.Range("F1")        '★月入力セル(元シートのF1)
    Set cR = shF.Range("H1:H2")     '★抽出条件領域(元シートのH1:H2)

    r.Rows(1).Copy shT.Range("C5")  'タイトル行コピー

    cR.ClearContents
    cR.Cells(2).Formula = "=MONTH(D6)=" & mR.Address(External:=True)
    r.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=cR, CopyToRange:=shT.Range("C5:Y5")
    cR.ClearContents

    Set r = shT.Range("C5", shT.Range("C" & Rows.Count).End(xlUp)).EntireRow.Columns("C:Y")

    r.Sort Key1:=shT.Range("H1"), order1:=xlAscending, Key2:=shT.Range("D1"), order2:=xlAscending, Header:=xlYes

    ReProtect shF, "00001"   '★
    ReProtect shT, "00001"   '★

 End Sub

Sub SortTest2()

   Worksheets("データ入力").Activate

   ActiveSheet.Unprotect Password:="00001"

   Range("C6:Y125").Sort Key1:=Range("H6"), order1:=xlAscending, _
                          Key2:=Range("D6"), order2:=xlAscending

   'シート保護解除前に設定されていた保護条件を継承して再保護
   ReProtect ActiveSheet

End Sub

Sub ReProtect(sh As Worksheet)
'現在の保護要素を継承したシート再保護

   Dim pp As Protection
   Dim sv As Long

   With sh   '対象シート
       sv = .EnableSelection
       Set pp = .Protection

       .Protect Password:="00001", Contents:=True, _
                   DrawingObjects:=Not .ProtectDrawingObjects, _
                   Scenarios:=Not .ProtectScenarios, _
                   AllowFormattingCells:=pp.AllowFormattingCells, _
                   AllowFormattingColumns:=pp.AllowFormattingColumns, _
                   AllowFormattingRows:=pp.AllowFormattingRows, _
                   AllowInsertingColumns:=pp.AllowInsertingColumns, _
                   AllowInsertingRows:=pp.AllowInsertingRows, _
                   AllowInsertingHyperlinks:=pp.AllowInsertingHyperlinks, _
                   AllowDeletingColumns:=pp.AllowDeletingColumns, _
                   AllowDeletingRows:=pp.AllowDeletingRows, _
                   AllowSorting:=pp.AllowSorting, _
                   AllowFiltering:=pp.AllowFiltering, _
                   AllowUsingPivotTables:=pp.AllowUsingPivotTables
       .EnableSelection = sv
   End With
End Sub

（だいちゃん） 2016/12/18(日) 00:30

βさんがおっしゃるように、現状のSortTest2 をべースにしたいです。
よろしくお願いします。Sort Test1はそのまま使いたいです。
（だいちゃん） 2016/12/18(日) 00:37

 >>まず、元スレでご教示頂いたものを確認したところ、コンパイルエラーが表示されてしまいます。

 元スレで、

 どのコードでエラーになったのか、そのときに同時に出ていたメッセージ文言は何だったか。
 これが、やりとりする上での必須条件です。

 とコメントし、だいちゃんさんから

 >>はい、よろしくお願いします。

 とレスがあったわけですが、わかっていただけなかったようですねぇ・・・・・

 だいちゃんさんのかわりに、このコードを貼り付けてコンパイルして、エラーの場所をさがしました。

 ★元スレで　Sample1 と Sample2 をアップした際に、それようの　ReProtect　も一緒にアップしてますよねぇ・・・
　なぜ、ReProtect　が、昔のコードのままなんでしょうか？

（β） 2016/12/18(日) 01:32

 で、B3:B12 ですけど、H列に名前が入っている、この名前の並び順として B3:B12 に入っている最大10個の名前の順番に
 並び替えたいということですね。

 今まで並び替えは、コードがシンプルな Sortメソッドを使っていましたが、新しい Sortオブジェクトを使います。
 (Sortメソッドでもできるんですが、かえって面倒になるので）
 この名前群の指定文字列は255文字以内の制約がありますが、10個の名前ぐらいは大丈夫でしょう。

 コードを書いたらアップしますのでしばらくお待ちください。

（β） 2016/12/18(日) 01:41

 以下で試してみてください。　念のために、最新の　ReProtect　もアップします。

 Sub Test()
    Dim sh As Worksheet
    Dim a As Range
    Dim r As Range
    Dim w As Variant

    Set sh = Sheets("データ入力")
    sh.Unprotect "0001"

    '指定並び替えリストの作成
    w = WorksheetFunction.Transpose(sh.Range("B3").Resize(WorksheetFunction.CountA(sh.Range("B3:B12"))))
    'タイトル行含んだリスト領域
    Set a = sh.Range("C5", sh.Range("C" & Rows.Count).End(xlUp)).EntireRow.Columns("C:Y")

    With sh.Sort.SortFields
        .Clear
        .Add Key:=sh.Range("H5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal, CustomOrder:=CStr(Join(w, ","))
        .Add Key:=sh.Range("D5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    End With

    With sh.Sort
        .SetRange a
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ReProtect sh, "0001"

 End Sub

 Sub ReProtect(sh As Worksheet, Optional pwd As String = "")
 '現在の保護要素を継承したシート再保護
    Dim pp As Protection
    Dim sv As Long

    With sh   '対象シート
        sv = .EnableSelection
        Set pp = .Protection

        .Protect Password:=pwd, Contents:=True, _
                    DrawingObjects:=Not .ProtectDrawingObjects, _
                    Scenarios:=Not .ProtectScenarios, _
                    AllowFormattingCells:=pp.AllowFormattingCells, _
                    AllowFormattingColumns:=pp.AllowFormattingColumns, _
                    AllowFormattingRows:=pp.AllowFormattingRows, _
                    AllowInsertingColumns:=pp.AllowInsertingColumns, _
                    AllowInsertingRows:=pp.AllowInsertingRows, _
                    AllowInsertingHyperlinks:=pp.AllowInsertingHyperlinks, _
                    AllowDeletingColumns:=pp.AllowDeletingColumns, _
                    AllowDeletingRows:=pp.AllowDeletingRows, _
                    AllowSorting:=pp.AllowSorting, _
                    AllowFiltering:=pp.AllowFiltering, _
                    AllowUsingPivotTables:=pp.AllowUsingPivotTables
        .EnableSelection = sv
    End With

 End Sub

（β） 2016/12/18(日) 02:02

βさん、すみません＆ありがとうございます。

早速やってみての質問ですが・・・
B3:B12は、どのシートを指定しているのでしょうか？ちなみに、私は「マスター」というシートのB3:B12に名前の一覧を作りたいと思っています。

それから、以前のコードですと、「D列とG列」「H列とD列」の2パターンで並び替えが可能だったと思いますが、今回修正いただいたコードは、この2パターンの並び替えは可能なのでしょうか？出来れば、これは維持したいです。それに加えて、今回の名前一覧順に並び替えさせたいです。

どうぞよろしくお願いします。
（だいちゃん） 2016/12/18(日) 19:47

 >>B3:B12は、どのシートを指定しているのでしょうか？
 >>ちなみに、私は「マスター」というシートのB3:B12に名前の一覧を作りたいと思っています。

 あぁ、そうなんですか。でも、そんなこと言ってましたっけ？

 アップしたコード、そんなに入り組んだコード構成にはなっていませんよね。
 意味がわからないところもあるかもしれませんが、眺めていると、なんとなく、わかりませんか？

 Set sh = Sheets("データ入力")　として　データ入力シート　を変数 sh にいれています。
 いいかえると、sh は データ入力シートそのものです。

 で、

 w = WorksheetFunction.Transpose(sh.Range("B3").Resize(WorksheetFunction.CountA(sh.Range("B3:B12"))))

 こんなところがありますよね。
 このコードの中で２か所 sh.なんたら　としています。つまり　データ入力シートのなんたら　という意味です。

 この sh を　Sheets("マスター") にかえればいいかな？　と、想像できませんか？

 >>今回修正いただいたコードは、この2パターンの並び替えは可能なのでしょうか？

 可能なわけはありませんよね。
 今回のものは H列の指定名前順とD列の通常の昇順。
 それ以外のものはできませんよね。

 >>出来れば、これは維持したいです。それに加えて、今回の名前一覧順に並び替えさせたいです。

 う～ん・・・・・
 サンプルとして Test をアップしたわけですけど、それをじっと見れば、それぞれのパターンのコードは、どこをどう変えればいいか
 これも、眺めていれば想像がつくと思うのですが？

 やはり、少しは、もらったコードを、（ただ貼り付けて、うまくいった、エラーだったではなく）
 ざっと眺めて、ある程度は理解しましょう。込み入ったコードではないので、わかるはずですよ。

 今回、これがしたいというパターンを構成する要素は、すべて アップした Test の中に入っています。

 だいちゃんさんが言っていることは、たとえば

 A1 と A2 に入っている数字を足して B1 に表示する数式を教えてください　という質問をして
 B1 に =A1+A2 という回答をもらった後、要件が変わりました。　元のセルは A10 と A11 になりました。
 どこを直したらいいですかと、そう聞いているのと同じですよ。

（β） 2016/12/18(日) 20:44

shをマスターに修正し、うまく動きました。ありがとうございます。

すみません。ご指摘のとおりです。
マスターというシートにというのは、最初はお伝えしていませんでした。すみません。

ただ、最初の「D列とG列」「H列とD列」の2パターンの並び替えを維持しながら、今回の名前順での形に出来れば理想的なものになるのですが・・・
再三、ご指摘いただいているのに情報がばらばらで申し訳ありません。

今一度どうぞよろしくお願いします。

（だいちゃん） 2016/12/18(日) 21:18

追伸
私のイメージは、最初の2パターンの並び替えをボタンを使って行い、H列の並び替えは名前を参照して並び替えるという形にしたいです。かつ、データ入力シート以外にボタンを作成してもシート移動しない形にできればと思います。
（だいちゃん） 2016/12/18(日) 21:23

 う～ん・・・

 希望の組み合わせのパターンをすべてコードにしてアップするのはご容赦。
 アップ済みの　Test、コメントしたように、この中にはだいちゃんさんがやりたいことを実現する
 部品がすべて含まれています。

 各パターンに対応するコードを作るとしたら、違うのは H だったり D だったり　G だったり、
 かつ、標準の昇順、降順なのか あるいは、特定の名前の指定順なのか　そういったところだけです。

 コードの中で　並び替えの条件指定をしているところは

        .Add Key:=sh.Range("H5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal, CustomOrder:=CStr(Join(w, ","))
        .Add Key:=sh.Range("D5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

 ここだけです。

 上のコードは H列で並び替え、ただし、標準の並び順ではなく、指定の名前の並び替えという意味です。
 もし、これが

        .Add Key:=sh.Range("H5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

 なら、H列は標準の昇順並び替えになります。

 下のコードは D列で並び替え、CustomOrder:　がないので、通常の昇順並び替えになります。

 今回の要件は並び替えキーの列が２つだけですので、２行のみ記述していますが、３行でも４行でも
 必要なだけ、いくつでも書くことができます。

 そうすると、D列とG列　なら、この２行のコードの H と D を D と G に変えればいいわけですね。
 また、CustomOrder:　が必要なら指定、必要なければ指定しない。

 アップ済みの Test に対して、↑でいったことを反映すれば、だいちゃんさんがほしいパターンのマクロが
 いくつでもできあがります。要は、この並び順指定の組み合わせを変えるということです。

 なお、CustomOrder:　を指定しない場合は（不要な場合は）そのリストを作り上げるところも不要ですので
 そこは、削除すればいいのですが、最悪、そのままにしておいても、害はありません。
 無駄になるだけですので。

 ★追伸の件、シートの移動はしていないと何度もコメントしていますよね。
 　何度も、そういっているのに、そちらから「シート移動しない形にしたい」といわれると
 　えっ？どこか、間違っているのかな、シートが動いてしまうのかなと、そう受け取ってしまいますよ。

 　なぜ、何度も、何度も　「移動させたくない」と書くのですか？

 　もし、どうなっているのか不安であれば、関連シートとは別のシートを表示した状態でマクロ実行してみてください。
 　シートが動かないということがわかるはずですよ？？

（β） 2016/12/18(日) 22:43

一つ気づいたことがあります。
並び替えをすると、データ入力シートの6行目から並び替えさせたいところが、7行目からしか並び替えしていません。6行目はとどまったままになっています。構文を見たのですが、問題を検出できません。
さらなるご指導をよろしくお願いします。
（だいちゃん） 2016/12/18(日) 23:45

 動かなかった 6行目の H6 には、どんな名前が入っていますか？
 その名前は B3:B12 の名前リストの中にありますか？

（β） 2016/12/19(月) 07:24

おはようございます。
βさん、ありがとうございます。
H6には以下の行と同様の名前が入っています。H7と同様の名前です。

それから、
βさんのご指導をもとに、以下のように2パターンでの並び替えを行えるようにTest2を追加してみました。
再三お伝えいただいていたにも関わらず、私の理解が足りなかったシート移動の件についてもデータ入力シート以外にボタンを作成し、実行してもシート移動はせず、まさに私の理想とするマクロができました。本当にありがとうございます。
ただ、前述にもあるように、Test2の●部分が不要な部分ということですよね？
今一度、添削願います。

さらなる質問です。
データ入力シート以外に設定したボタンで並び替えを行い、データ入力シートに戻ってみると、並び替え範囲が選択された状態（反転した状態）となっています。データ入力シート自体で並び替えさせた場合は、反転しません。この他シートで並び替えした場合、反転状態にならないようにするためには、どのような処理が必要でしょうか？
昨夜質問させていただいている6行目が並び替え対象になっていないという改善と併せて、さらなるご指導をよろしくお願いします。

Sub Test1()

    Dim sh As Worksheet
    Dim a As Range
    Dim r As Range
    Dim w As Variant

    Set sh = Sheets("データ入力")
    sh.Unprotect "00001"

    '指定並び替えリストの作成
    w = WorksheetFunction.Transpose(Sheets("マスター").Range("B3").Resize(WorksheetFunction.CountA(Sheets("マスター").Range("B3:B12"))))
    'タイトル行含んだリスト領域
    Set a = sh.Range("C5", sh.Range("C" & Rows.Count).End(xlUp)).EntireRow.Columns("C:Y")

    With sh.Sort.SortFields
        .Clear
        .Add Key:=sh.Range("H5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal, CustomOrder:=CStr(Join(w, ","))
        .Add Key:=sh.Range("D5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    End With

    With sh.Sort
        .SetRange a
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ReProtect sh, "00001"

 End Sub

 Sub Test2()
    Dim sh As Worksheet
    Dim a As Range
    Dim r As Range
    Dim w As Variant

    Set sh = Sheets("データ入力")
    sh.Unprotect "00001"

● '指定並び替えリストの作成
● w = WorksheetFunction.Transpose(Sheets("マスター").Range("B3").Resize
(WorksheetFunction.CountA(Sheets("マスター").Range("B3:B12"))))
● 'タイトル行含んだリスト領域
● Set a = sh.Range("C5", sh.Range("C" & Rows.Count).End(xlUp)).EntireRow.Columns("C:Y")

    With sh.Sort.SortFields
        .Clear
        .Add Key:=sh.Range("D5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=sh.Range("G5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    End With

    With sh.Sort
        .SetRange a
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ReProtect sh, "00001"

 End Sub

 Sub ReProtect(sh As Worksheet, Optional pwd As String = "")
 '現在の保護要素を継承したシート再保護
    Dim pp As Protection
    Dim sv As Long

    With sh   '対象シート
        sv = .EnableSelection
        Set pp = .Protection

        .Protect Password:=pwd, Contents:=True, _
                    DrawingObjects:=Not .ProtectDrawingObjects, _
                    Scenarios:=Not .ProtectScenarios, _
                    AllowFormattingCells:=pp.AllowFormattingCells, _
                    AllowFormattingColumns:=pp.AllowFormattingColumns, _
                    AllowFormattingRows:=pp.AllowFormattingRows, _
                    AllowInsertingColumns:=pp.AllowInsertingColumns, _
                    AllowInsertingRows:=pp.AllowInsertingRows, _
                    AllowInsertingHyperlinks:=pp.AllowInsertingHyperlinks, _
                    AllowDeletingColumns:=pp.AllowDeletingColumns, _
                    AllowDeletingRows:=pp.AllowDeletingRows, _
                    AllowSorting:=pp.AllowSorting, _
                    AllowFiltering:=pp.AllowFiltering, _
                    AllowUsingPivotTables:=pp.AllowUsingPivotTables
        .EnableSelection = sv
    End With

 End Sub

（だいちゃん） 2016/12/19(月) 07:36

それと関連でもう一つ。
並び替えさせると、先頭行に戻ってしまいますよね。
例えば、画面上は70行目ぐらいの状態で並び替えさせると、先頭行に戻ってしまいます。これを戻らないように、70行目の状態のままで並び替えさせるようにしたいです。
どうぞよろしくお願いします。
（だいちゃん） 2016/12/19(月) 07:39

その名前は B3:B12 の名前リストの中にありますか？

はい、リストの先頭B3にある名前になります。

（だいちゃん） 2016/12/19(月) 08:20

 6行目が並び替え対象行にならないのは全く原因がわかりません。
 こちらでは、問題なく並び替えられていますので。
 そちらのシート実物が見えないので、悩ましいところですね。

 並び替え領域が選択状態になる件、今まで並び替えだけのマクロを使ったことがなかったので気が付きませんでしたが
 SortオブジェクトのApply方式を使うと、確かにそうなりますね。
 旧来の Sortメソッドなら、そうなりません。まぁ、これはＭＳの仕様ということでしょう。

 どうしても反転状態がいやだということなら、Sortメソッドを使わざるを得ないでしょうね。
 Sortメソッドの制約としては　並び替え列が１度には３列までしか指定できないということで、今回の場合は
 4列以上の要望はないようですから、Sortメソッド方式の記述にかえてもいいのですが、ネックは指定名前順。
 Sortメソッドでもできないことはないのですが、

 マクロ内でユーザー指定リストに登録
 そのリストを使って並び替え
 マクロ内で登録したユーザー指定リストを削除

 こんな面倒なことをしなければいけません。（そのコードを書く気力は、今のところありません）

 スクロールした状態で並び替え後、先頭に戻る件ですが、これも　SortメソッドとSortオブジェクトの仕様の
 不統一ですね。Sortメソッドなら、どんな状態でも、先頭には戻りません。
 ただ、Sortオブジェクトで先頭に戻るのは、そのシートを表示して実行した場合ですね。
 対象シートがスクロールされていても、別シートを表示した状態で実行すれば、並び替え後の対象シートは
 そのままの位置で表示されるようですよ。

 これは（これも）仕様だと思ってあきらめてはいかが？
 どうしてもいやだということなら、実行前の対象シートの位置を保存しておいて、実行後、その位置に戻すということは
 もちろんできますが、そこまでやることもないでしょ？
（これについても、そのコードを書く気力は、今のところありません）

 いずれにしても、6行目の問題は、もう少し、こちらでも調査はしてみますが・・・原因がつかめない公算のほうが大。

 ★ためしに　6行目の名前をリストにある他の名前にして実行するとどうなりますか？

 そうそう、指定名前順が不要の場合の不要コードで巣が

     Dim w As Variant

 これも不要です。

 逆に

  'タイトル行含んだリスト領域 
  Set a = sh.Range("C5", sh.Range("C" & Rows.Count).End(xlUp)).EntireRow.Columns("C:Y")

 これは必須ですよ。消してはいけません。

（β） 2016/12/19(月) 09:16

βさん、誠にありがとうございます。

6行目の問題以外は、特に現状のままでも問題ないので、あきらめます。というか、大丈夫です。

ただ、6行目の問題については、どうかお願いしたいです。必要であれば、データを見ていただいても構いません。6行目だけ残ってしまうということは、並び替えが不完全な状態であるため、どうかよろしくお願いいたします。

★ためしに　6行目の名前をリストにある他の名前にして実行するとどうなりますか？名前を変えてみましたが、改善しませんでした。

どうぞよろしくお願いします！
（だいちゃん） 2016/12/19(月) 12:21

Test2は以下のようになりますね。
βさんの添削いただいたものを削除と残して
　削除　Dim w As Variant
　残し 'タイトル行含んだリスト領域

  Set a = sh.Range("C5", sh.Range("C" & Rows.Count).End(xlUp)).EntireRow.Columns("C:Y")

Sub Test2()

    Dim sh As Worksheet
    Dim a As Range
    Dim r As Range

    Set sh = Sheets("データ入力")
    sh.Unprotect "00001"

    'タイトル行含んだリスト領域
    Set a = sh.Range("C5", sh.Range("C" & Rows.Count).End(xlUp)).EntireRow.Columns("C:Y")

    With sh.Sort.SortFields
        .Clear
        .Add Key:=sh.Range("D5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=sh.Range("G5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    End With

    With sh.Sort
        .SetRange a
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ReProtect sh, "00001"

 End Sub
（だいちゃん） 2016/12/19(月) 12:27

 >>必要であれば、データを見ていただいても構いません

 見ることが可能なら見ますよ。
 ブックそのものを見たいので、どこかのアップロード/ダウンロードサイトにでもアップしてください。

（β） 2016/12/19(月) 12:32

すいません。レベルが低くて。
アップの仕方が分からなくて・・・
メール等は難しいですかね。
（だいちゃん） 2016/12/19(月) 12:35

βさん、何度か試していると、他のシートのボタンを押すと、一瞬データ入力シートに移動してしまいます。

（だいちゃん） 2016/12/19(月) 13:33

 う～ん・・・　前トピでも書きましたが、これだけの　並び替えだけの処理に、前トピも含めると
 こうも、延々とＱ／Ａが続く・・・　疲れます。正直言って。

 >>メール等は難しいですかね。

 メール添付はお断りします。
 ネットをさがせばいくらでも無料のアップロード／ダウンロードサービスがでてきますので
 そういったものを利用してください。使い方は、そのサイトの説明を読んでください。

 >>何度か試していると、他のシートのボタンを押すと、一瞬データ入力シートに移動してしまいます。

 何度も言ってますが、少なくとも本トピに私がアップしたコードではそうなりません。
 元トピのだいちゃんさんのコードは、シート.Activate してましたから、シートは移動しますし、それをうけて
 私が提供したコードも、だいちゃんさんが理解しやすいように　シート.Activate をしていましたが
 元トピの最後のコードからは、一切、そういうことはありません。

 もっとも、「一瞬」というのが、ちらっと　並び替え対象のシートが見えて、そのあと、ボタンを押したシートに戻る
 ということであれば、もしかしたら　xl2016 が、そういう仕様なのかもしれません。
 当方には xl2016 がないので確認はできませんが。

 そもそも、そちらでは、どのシートに　ボタンを配置しているのですか？
 「他のシート」のボタン　という表現が気になります。

（β） 2016/12/19(月) 15:30

 それと・・・・

 6行目が並び替え対象にならないという、その、そちらの実行したコードをそのまま、学校にアップしてください。
 まさか、だいちゃんさんが独自に書いたコードで　当初のまま　Range("C6:Y125") を並び替え領域として記述して
 かつ、Header:=xlYes にしているなんてことはないでしょうけど、確認したいので。

 もし、こうなっていれば、当然 6行目は　並び替え対象外になりますよね。

（β） 2016/12/19(月) 15:35

以下が現在のコードになります。
その他の回答は後ほどですみません。

Sub Test1()

    Dim sh As Worksheet
    Dim a As Range
    Dim r As Range
    Dim w As Variant

    Set sh = Sheets("データ入力")
    sh.Unprotect "00001"

    '指定並び替えリストの作成
    w = WorksheetFunction.Transpose(Sheets("マスター").Range("B3").Resize(WorksheetFunction.CountA(Sheets("マスター").Range("B3:B12"))))
    'タイトル行含んだリスト領域
    Set a = sh.Range("C5", sh.Range("C" & Rows.Count).End(xlUp)).EntireRow.Columns("C:Y")

    With sh.Sort.SortFields
        .Clear
        .Add Key:=sh.Range("H5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal, CustomOrder:=CStr(Join(w, ","))
        .Add Key:=sh.Range("D5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    End With

    With sh.Sort
        .SetRange a
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ReProtect sh, "00001"

 End Sub

 Sub Test2()
    Dim sh As Worksheet
    Dim a As Range
    Dim r As Range

    Set sh = Sheets("データ入力")
    sh.Unprotect "00001"

    'タイトル行含んだリスト領域
    Set a = sh.Range("C5", sh.Range("C" & Rows.Count).End(xlUp)).EntireRow.Columns("C:Y")

    With sh.Sort.SortFields
        .Clear
        .Add Key:=sh.Range("D5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=sh.Range("G5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    End With

    With sh.Sort
        .SetRange a
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ReProtect sh, "00001"

 End Sub

 Sub ReProtect(sh As Worksheet, Optional pwd As String = "")
 '現在の保護要素を継承したシート再保護
    Dim pp As Protection
    Dim sv As Long

    With sh   '対象シート
        sv = .EnableSelection
        Set pp = .Protection

        .Protect Password:=pwd, Contents:=True, _
                    DrawingObjects:=Not .ProtectDrawingObjects, _
                    Scenarios:=Not .ProtectScenarios, _
                    AllowFormattingCells:=pp.AllowFormattingCells, _
                    AllowFormattingColumns:=pp.AllowFormattingColumns, _
                    AllowFormattingRows:=pp.AllowFormattingRows, _
                    AllowInsertingColumns:=pp.AllowInsertingColumns, _
                    AllowInsertingRows:=pp.AllowInsertingRows, _
                    AllowInsertingHyperlinks:=pp.AllowInsertingHyperlinks, _
                    AllowDeletingColumns:=pp.AllowDeletingColumns, _
                    AllowDeletingRows:=pp.AllowDeletingRows, _
                    AllowSorting:=pp.AllowSorting, _
                    AllowFiltering:=pp.AllowFiltering, _
                    AllowUsingPivotTables:=pp.AllowUsingPivotTables
        .EnableSelection = sv
    End With

 End Sub
（だいちゃん） 2016/12/19(月) 15:55

 で、６行目が対象外になるのはどちらですか？
 それとも、両方ですか？

（β） 2016/12/19(月) 17:13

βさん、ロングバージョンになってしまい、本当にすみません。

どちらも対象外になってしまいます。。。
（だいちゃん） 2016/12/19(月) 17:16

βさん、申し訳ありません。
タイトル行が実は４行と５行の二段にしてまして、そのセルの結合を解除したところ、６行目をしっかり並び替えさせてくれました。
このたびは、本当に最後まで親身にありがとうございました。その中で、βさんに色々とご指摘頂きました。これを今後に活かしていきたいと思っております。これに懲りず、今後ともよろしくお願いします。
おかげさまで、イメージどおりのデータを作成できました。本当に本当にありがとうございました。
（だいちゃん） 2016/12/19(月) 17:33

 もう見ないかもしれませんが、お疲れ様（お互いに）

 もし、4,5行目のタイトル行結合が必須なら、Test1,Test2 ともに　C5 等　○5 を　C6 等　○6 にして
 .Header = xlYes を　.Header = xlNo に変えればＯＫです。

 ご参考まで。

（β） 2016/12/19(月) 17:54

コメント返信：

[ 一覧(最新更新順) ]

[[20161217161056]] 『[20161208210653]並べ替えを自動化させた関連』（だいちゃん） ページの最後に飛ぶ

[[20161217161056]]　『[20161208210653]並べ替えを自動化させた関連』（だいちゃん）　ページの最後に飛ぶ