『並べ替えを自動化させたい』(だいちゃん) シート1に以下のような表があります。 この表は基になるもので、直接入力しています。 これを入力したら自動で並び変わるようにつくりたいのです。 第一に日付順、第二に車番順で並べ替えたいです。このシートはマクロなどを使用して。 A B   C   D     E 1  No. 日付    名前    車番  2 1  9/ 1  山田次郎  269 3 2  9/10   山下花子 268 4 3  10/ 4   山田次郎 256 5 4  10/20  佐藤五郎 255 6 5  11/ 3   山下花子 298 7 6  11/ 9   山田次郎 288 ・ ・ ・ シート2にはシート1のデータを基に月ごとデータを抽出するようにして、かつ、ここでは第一に名前順、日付順で関数によって並べ替えさせられればと思います。 どうぞよろしくお願いします。 < 使用 Excel:Excel2016、使用 OS:Windows10 > ---- シート1の並び替え、操作はできますよね、もちろん。 その操作をマクロ記録すれば、基本となるコードが生成されます。 あとは、コード内で固定になっているセル領域を変数化すればいいのですが、 まず、そこまでやって、変数化が自分ではできなかったら、継続して質問されてはいかがですか。 シート2の件については、関数でもできるんでしょうけど、シート1にオートフィルターを設定して 抜き出して、その結果をシート2にコピペして並び替え、 あるいは シート1からフィルターオプションで直接シート2に抽出して並び替え。 必要ならこういった操作をマクロ記録して、マクロ対応されたらいいのでは? (β) 2016/12/08(木) 21:31 ---- ありがとうございます。 すみません、具体的にご教示いただけると助かります。 (だいちゃ) 2016/12/08(木) 21:39 ---- ありがとうございます。 すみません、具体的にご教示いただけると助かります。 (だいちゃん) 2016/12/08(木) 21:42 ---- 具体的にやり方が示されているんじゃないですか? 結果を待つだけではなく、指摘に沿ってご自分でトライなさったらいかがでしょうか。 (γ) 2016/12/08(木) 21:48 ---- わかりました (だいちゃん) 2016/12/08(木) 21:56 ---- いろいろと参考にしながら、以下のように組み立ててみましたが、コンパイルエラーがでてしまいます。 すみません、力をいただければと思います。よろしくお願いします。 Sub SortTest() Worksheets("Sheet1").Range(Cells(1, 1), Cells(300, 3)) _ .Sort Key1:=Worksheets("Sheet1").Cells(1, 1), order1:=xlDescending, _ Key2:=Worksheets("Sheet1").Cells(1, 2), order2:=xlAscending, _ Key3:=Worksheets("Sheet1").Cells(1, 3), order3:=xlDescending End Sub Sub SortTest() Worksheets("Sheet1").Activate Worksheets("Sheet1").Range("A1:C100") _ .Sort Key1:=Range("C2"), order1:=xlDescending, _ Key2:=Range("E2"), order2:=xlAscending, _ End Sub (だいちゃん) 2016/12/09(金) 07:39 ---- 下の方はKey2のカンマ以降(Key3部分)が無いので構文エラーになる。 もし、構文エラーでなく両方とも一つのモジュール内に書いて名前が適切でないというエラーであれば両方とも 同じ名前のためなので片方を違う名前に変えてみてくれ。 もし、それ以外であればエラー内容を説明してくれ。 (ねむねむ) 2016/12/09(金) 09:27 ---- もろかぶりですが。 2つ考えられます。 1.同じモジュールに 同じ名前を持つプロシジャを書くことは許されていません。   一方の名前を変えましょう。 2.1行のコードが長くなった場合に見づらいので、適宜 半角スペース と _ を継続マークとして   行を変えてコーディングすることができますが、コードの最後に 継続マークをおいてはいけません。 Key2:=Range("E2"), order2:=xlAscending, _   これでおわっていますね。コンパイラーは継続行があると期待します。でもない。   なので叱られます。 (β) 2016/12/09(金) 09:28 ---- 私だったら、同日に同じ人の同じ車番が出ないならシート2はピボットにしちゃうかな。 勝手に並べ替えてくれるし。 (コナミ) 2016/12/09(金) 10:19 ---- ピボットもこの処理にマッチした方法だと思いますが、私がコメントしたフィルターオプション処理案です。 以下の操作をマクロ記録しますと、そのまま使えるマクロコードが生成されます。 マクロではなく操作でも、わりあい簡単にできると思います。並び替えは行われませんので別途、並び替えることが 必要ですが。 ●準備  操作者が抽出月を指定するわけですが、それを F1 に入れるとします。 1 とか 12 とか、数字でいれます。  このままでは、フィルターオプションの抽出条件になりませんので、H1:H2 を抽出条件欄として準備しておきます。  H1 : 空白 (項目に関係なく、リスト内のデータに対する抽出条件を数式で与える という意味です)  H2 : =MONTH(B2)=$F&1 リストの最初のデータ(2行目)の抽出条件式です。  で、抽出シート(Sheet2) のセルをクリアして空白にしておきます。  このH1:H2 は実行時には非表示でも構いませんので、H列を非表示にしておいたほうがいいかもしれません。 できあがったマクロを、実行時にどのシートがあるてぃぶになっていても問題ないように SHeet1 を選択してから  以下の操作を開始してください。 ●操作(マクロ記録)  1.Sheet2 を選択  2.データタブ 詳細設定  3.でてきたダイアログで    1)リスト範囲(L) を Sheet1 の A列:D列    2)検索条件範囲(C) を SHeet1 の H1:H2    3)指定した範囲(O) を選び、抽出範囲(T) に Sheet2 の A1:D1    4)OKボタン SHeet1 の F1 に抽出月の数字を入力して、このマクロを実行すると、目的のデータが抽出されます。 (β) 2016/12/09(金) 12:03 ---- ご指摘頂いた箇所を修正し、 シート名は実際のシート名に修正し、 セル番号も実際のせる番号に以下のとおり修正して実行したところ、 「実行時エラー1004 アプリケーション定義又はオブジェクト定義エラーです」 と表示されてしまいます。今一度ご教示のほどよろしくお願いします。 なお、これをEnterキーを押して実行という構文を追加したいのですが、色々見ても分からず、 これについてもご教示頂ければ有難いです。 よろしくお願いします。 Sub SortTest1() Worksheets("データ入力").Range(Cells(1, 1), Cells(300, 3)) _ .Sort Key1:=Worksheets("データ入力").Cells(1, 1), order1:=xlDescending, _ Key2:=Worksheets("データ入力").Cells(1, 2), order2:=xlAscending, _ Key3:=Worksheets("データ入力").Cells(1, 3), order3:=xlDescending End Sub Sub SortTest2() Worksheets("データ入力").Activate Worksheets("データ入力").Range("C6:Y125") _ .Sort Key1:=Range("D6"), order1:=xlDescending, _ Key2:=Range("G6"), order2:=xlAscending End Sub (だいちゃん) 2016/12/09(金) 12:42 ---- βさん、ご教示ありがとうございます。 質問が前後してしまいました。 よろしくお願いします。 (だいちゃん) 2016/12/09(金) 12:43 ---- SortTest1 も SortTest2 も、それぞれ【危うさ】を内包しています。 ●SortTest1 関連の対象セル領域にシート修飾をしている、そのことは、非常に素晴らしいのですが 2か所、うっかり部分があります。 Worksheets("データ入力").Range(Cells(1, 1), Cells(300, 3)) この Range 内のセル記述。 どのシートのセル領域かが明言されていませんね。 標準モジュールの場合、こういったセル領域は【アクティブシート】のセル領域だとみなします。 もし、このコード実行時、アクティブシートが データ入力ではない 別シートだった場合、 この領域記述を日本語であらわしますと データ入力シートの領域です。 その詳細は 別シートのCells(1, 1) から 別シートの Cells(300, 3) までの領域です。 こんな、おかしな領域宣言になります。なのでエクセルから叱られます。 SortTest2 でやっているように Worksheets("データ入力").Range("A1:C300") と記述するか Worksheets("データ入力").Range(Worksheets("データ入力").Cells(1, 1), Worksheets("データ入力").Cells(300, 3)) こんな記述が必要です。 ●SortTest2 このコードは、結果オーライで、エラーなく処理されます。 Worksheets("データ入力").Activate これがあるので、処理時には データ入力シートがアクティブになっています。 なので、セル領域に、どのシートかを指定しなくても、データ入力シートだと認識されます。 この記述であれば、Worksheets("データ入力").Range("C6:Y125") _ でも、もちろんいいのですが Range("C6:Y125") _ でもOKです。 ただ、もし、Worksheets("データ入力").Activate がなかったら、SortTest1でコメントしたのと同様の問題、 別シートをアクティブにして実行すると、エラーにはなりませんが、別シートのデータが並び替えられます。 (β) 2016/12/09(金) 13:48 ---- ありがとうございます。 しかし、エラー400が表示されてしまいます・・・ Sub SortTest1() Worksheets("データ入力").Activate Worksheets("データ入力").Range("C6:Y125") _ .Sort Key1:=Worksheets("データ入力").Cells(1, 1), order1:=xlDescending, _ Key2:=Worksheets("データ入力").Cells(1, 2), order2:=xlAscending, _ Key3:=Worksheets("データ入力").Cells(1, 3), order3:=xlDescending End Sub Sub SortTest2() Worksheets("データ入力").Activate Worksheets("データ入力").Range("C6:Y125") _ .Sort Key1:=Range("D6"), order1:=xlDescending, _ Key2:=Range("G6"), order2:=xlAscending End Sub (だいちゃん) 2016/12/09(金) 14:07 ---- >Worksheets("データ入力").Range("C6:Y125") _ これ、変更前は >Worksheets("データ入力").Range(Cells(1, 1), Cells(300, 3)) とA1セルからC300セルの範囲を示していたはずがC6セルからY125セルになっている。 ソート範囲は変更されているのにキー範囲は >.Sort Key1:=Worksheets("データ入力").Cells(1, 1), order1:=xlDescending, _ > Key2:=Worksheets("データ入力").Cells(1, 2), order2:=xlAscending, _ > Key3:=Worksheets("データ入力").Cells(1, 3), order3:=xlDescending とA列、B列、C列のままとなっている。 (ねむねむ) 2016/12/09(金) 14:28 ---- このような感じでしょうか それでもエラー400が出てしまいます Sub SortTest1() Worksheets("データ入力").Activate Worksheets("データ入力").Range("C6:Y125") _ .Sort Key1:=Worksheets("データ入力").Cells(6, 4), order1:=xlDescending, _ Key2:=Worksheets("データ入力").Cells(6, 7), order2:=xlAscending End Sub Sub SortTest2() Worksheets("データ入力").Activate Worksheets("データ入力").Range("C6:Y125") _ .Sort Key1:=Range("D6"), order1:=xlDescending, _ Key2:=Range("G6"), order2:=xlAscending End Sub (だいちゃん) 2016/12/09(金) 14:46 ---- エラー400がでたのは、SortTest1 ですか? SortTest2 ですか? それと、SortTest2 は データ入力シートから抽出して別シートに転記した、その別シートを並び替えるコードですよね。 テストですから、どちらも データ入力シートを相手にしても、かまわないといえばかまわないのですけど それでも、SortTest1 のほうは 1行目がタイトル行じゃなかったですか? レイアウトを変えて両方、6行目をタイトル行にしたんですか? もし、そうなら、私がアップしたフィルターオプションの手順の中の指定セル領域も変わってきますよ。 6行目からでもいいのですが、そうであれば、それなりに 操作もコードも面倒になります。 両方、1行目をタイトル行にすることを、強くおすすめします。 あぁ、それと、領域記述は Range でも Cells でもいいわけですが、1つの命令文の中に Range と Cells が混在するのは (それが、指定上必要な場合もありますが)あまり見やすいとは言えません。 (β) 2016/12/09(金) 15:03 ---- どちらもです。 マクロ初心者で初歩的なことばかりで申し訳ありません。 よろしくお願いします。 (だいちゃん) 2016/12/09(金) 15:06 ---- エラーは、1004 ではなく、400 なんですね? この2つのコード、これらは、どのモジュールに書いてありますか? もし、どこかのシートのシートモジュールに書いてあるとすれば、それを消して 標準モジュールに書いて試してみてください。 (ただ、そうだった場合、 SortTest1 はエラーにならないはずなので、??? ですけど・・) (β) 2016/12/09(金) 15:25 ---- 色々とありがとうございます。 βさんのご指示どおり、標準モジュールに書き直してためしたところ、エラーが変わりました。 エラー400だったものが、 「実行時エラー1004 RangeクラスのSortメソッドが失敗しました」 と出ています。 すみません。どうか、よろしくお願いします。 (だいちゃん) 2016/12/09(金) 15:37 ---- どちらも同じエラーです。 (だいちゃん) 2016/12/09(金) 15:43 ---- このシートに保護がかかってるなんてことはないですか? (β) 2016/12/09(金) 15:48 ---- すごいですね。知識の深さがすごいんですね。 保護をかけていました。うまくいきました。 あとは、この二つのマクロをEnterを押して実行という構文なのですが、 ご教示よろしくお願いします! (だいちゃん) 2016/12/09(金) 15:56 ---- ただ、これを保護をかけて使う方法はあるのでしょうか? 複数の方が使用するデータになるため、保護を出来ればかけたいのです。 (だいちゃん) 2016/12/09(金) 15:57 ---- マクロ内で保護を解除し、マクロの最後で保護をかけ直せば良いですよ。パスワードはかかっていますか? 保護を外したりかけたりするコードは、マクロの自動記録してみるのが良いです。 (???) 2016/12/09(金) 16:23 ---- すみません。 マクロの最後で保護をかけ直した方が分かりません。 今一度詳しく教えてください!お願いします。 (だいちゃん) 2016/12/09(金) 16:48 ---- 保護を外す時、 Sheets("データ入力").Unprotect Password:="パスワードを書く" 再び保護する時、 Sheets("データ入力").Protect Password:="パスワードを書く" (おせっかい) 2016/12/09(金) 17:02 ---- すみません。 これはどこに書くのでしょうか? よろしくお願いします。 (だいちゃん) 2016/12/09(金) 17:12 ---- 保護がかかっているシートをマクロで変更する場合、2つの方法があります。 1.マクロで書きこむ前に保護を解除、マクロで書き込みが終わったら、再保護。   これが一番確実で楽です。  ただし、この場合、再保護で留意すべき点があります。  シート保護の状態は様々です。手動でシート保護をかける際に、このシートのすべてのユーザーに許可する操作  というのがありますね。その様々な操作で許可したいものをチェックした上で保護を掛けるわけですが、  Sheets("データ入力").Protect Password:="パスワードを書く"  このコードの場合、Protect に対して、どの操作を許可するか、全く指定がないですね。  その場合、設定は、規定値となります。つまり許可する操作は ロックされたセルの選択とロックされていないセルの選択のみ。  その他の操作は禁止になります。仮に、このシート保護時、他の操作も許可してあったとしてもそれらが禁止されます。  回避する方法  これとこれは、このシートでは許可して保護をかけているということがわかっていれば(わかっていると思いますが)    Sheets("データ入力").Protect の引数として、それらの許可を明示的に与える。    どう与えればいいのかということについては、実際に、それら条件を許可して保護する操作をマクロ記録すれば    コード生成されまますので、それを、そのまま取り入れたらいいです。 2.ブックを開くときに、「特別な保護」をかけます。これは、保護のままで、でもマクロからは、かなりのことができるという保護です。   ただ、「かなりのことができる」というものの万能ではありません。変更の内容によっては、エクセルから、だめだよと叱られることもあります。   かつ、許可する操作については前述と同じです。これとこれを許可と明示的に指定するか、あるいは、今かかっている保護条件をすべて引き継ぐ   というコードにする必要があります。現在の条件を引き継ぐ ということなら、そのコードをアップしてもよろしいのですが   すでにコメントしたように万能ではないので、1.の方式をおすすめします。 >>あとは、この二つのマクロをEnterを押して実行という構文なのですが、 これは、すべてが完成した後に考えましょう。一歩ずつがベストです。 (β) 2016/12/09(金) 17:29 ---- βさん、ねむねむさん、???さん、おせっかいさん、rさん、コナミさん、皆さんありがとうございます。 これから退社して、夜にじっくりと拝見させていただきます。 まだまだ、ご教示頂きたいことがありますので、どうぞよろしくお願いします。 今日は、花金、忘年会等おありでしょう?私も度々の忘年会でアル中ぎみです。 見捨てず、どうぞよろしくお願いします。 (だいちゃん) 2016/12/09(金) 17:43 ---- さらに構文(Sub SortTest3()を追加しました。)を追加しました。うまく動いています。 それで、βさんのご教示いただいた保護の構文  Sheets("データ入力").Protect Password:="パスワードを書く" は、どこに書けばよいのでしょうか? 以下のように追加すると再びエラーが出てしまいます。 すいません。よろしくお願いします。 Sub SortTest1() Worksheets("データ入力").Activate Worksheets("データ入力").Range("C6:Y125") _ .Sort Key1:=Worksheets("データ入力").Cells(6, 4), order1:=xlAscending, _ Key2:=Worksheets("データ入力").Cells(6, 7), order2:=xlAscending End Sub Sub SortTest2() Worksheets("データ入力").Activate Worksheets("データ入力").Range("C6:Y125") _ .Sort Key1:=Range("D6"), order1:=xlAscending, _ Key2:=Range("G6"), order2:=xlAscending End Sub Sub SortTest3() Worksheets("データ入力").Activate Worksheets("データ入力").Range("C6:Y125") _ .Sort Key1:=Range("H6"), order1:=xlAscending, _ Key2:=Range("D6"), order2:=xlAscending End Sub Sheets("データ入力").Protect Password:="パスワードを書く" (だいちゃん) 2016/12/09(金) 19:28 ---- それから、このマクロのボタンを別のシートに作成して、そのボタンを押すと、元シート(入力データ)に戻ってしまいます。戻らないようにしたいのですが、どのような方法があるでしょうか? 併せてご教示いただきたいです。よろしくお願いします。 (だいちゃん) 2016/12/09(金) 21:24 ---- コードはすべて Sub と End Sub の間に記述しなければいけません。 アップされたように その中から外れてコードを書くとコンパイラーから叱られます。 叱られたときに出てくるメッセージを、ちゃんと読めば、そういったことが表現されていますよ。 とりあえず、SortTest1 をもとにサンプルです。 最初に Worksheets("データ入力").Activate としていますので ActiveSheet が データ入力シート ですね。 本来はシート修飾して、状況依存にはならない安全なコードを書くのが望ましいのですが、今、それに踏み込むと 混乱すると思いますので、このままの形(つまり、目的のシートは ActiveSheet)で。 シートの再保護は、SortTest1 の中に組み込んでもいいのですが、あえて別だてでサブプロシジャ化して、SortTest1では それを1行のコードを書くことで実行しています。 SortTest1 以外でも、再保護をかけるときは、同様に 1行の呼び出しコードで書くことができます。 なお、シート保護にパスワードがかかっていないというコードです。 パスワードが設定されているなら Protect も UnProtect も Password:="なんとか" が必要です。 Sub SortTest1() Worksheets("データ入力").Activate ActiveSheet.Unprotect Range("C6:Y125").Sort Key1:=Range("D6"), order1:=xlAscending, _ Key2:=Range("G6"), order2:=xlAscending 'シート保護解除前に設定されていた保護条件を継承して再保護 ReProtect ActiveSheet End Sub Sub ReProtect(sh As Worksheet) '現在の保護要素を継承したシート再保護 Dim pp As Protection With sh Set pp = .Protection .Protect DrawingObjects:=Not .ProtectDrawingObjects, _ Contents:=True, _ 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 End With End Sub ●それから、このマクロのボタンを別のシートに作成して、そのボタンを押すと、元シート(入力データ)に戻ってしまいます。戻らないようにしたいのですが、どのような方法があるでしょうか? これについても、今、つっこんでいくと、混乱すると思いますので、動くようになってからにしましょう。 (β) 2016/12/09(金) 21:27 ---- βさん、凄いですね。この道の専門職の方ですか? 余計なことですね。すいません。 ありがとうございます。まずはやってみます。 (だいちゃん) 2016/12/09(金) 21:35 ---- この構文を Sub SortTest1() Worksheets("データ入力").Activate Worksheets("データ入力").Range("C6:Y125") _ .Sort Key1:=Worksheets("データ入力").Cells(6, 4), order1:=xlAscending, _ Key2:=Worksheets("データ入力").Cells(6, 7), order2:=xlAscending End Sub に上書きでいいでしょうか? (だいちゃん) 2016/12/09(金) 21:45 ---- はい。上書きしてください。Sub ReProtect(sh As Worksheet) の部分も忘れないように。 ところで、当初、そちらからアップされたレイアウトは、1行目、A列から始まっていて先頭がタイトル行。 その後の、そちらのコードでは Range("C6:Y125") 。 レイアウトが変わったのですか? また、この Range("C6:Y125") の先頭はタイトル行ですか? データ行ですか? 並び替えを実行する際には 対象領域の先頭がタイトル行なのか、データ行なのかを Header:= で指定します。 アップされたそちらのコードでは、この指定がないですが? (指定がない時には 先頭はタイトルではなくデータだとみなされます。それでいいならいいのですが) そうそう、そちらは xl2016 なんですよね? で、コードの参考として並び替え操作をマクロ記録したんですよね? マクロ記録で Sortメソッド版が生成されるのは xl2003 まで、xl2007以降は Sortメソッドも使えますが マクロ記録すると 新しい Sortオブジェクトをベースにしたコードが生成されるはずなんですが? それとも(当方、xl2016 を持っていないのでわかりませんが)xl2016 ではマクロ記録で Sortメソッド版のコードが 生成されるのでしょうか? (β) 2016/12/09(金) 22:27 ---- βさんの質問に即答したいのですが、 質問のレベルが高過ぎて、正直、どう答えたらよかか分らんです。(急に九州弁ですいません。) はい。上書きしてください。Sub ReProtect(sh As Worksheet) の部分も忘れないように。 →これはどこに入れればよいのですか? ところで、当初、そちらからアップされたレイアウトは、1行目、A列から始まっていて先頭がタイトル行。 その後の、そちらのコードでは Range("C6:Y125") 。 レイアウトが変わったのですか? また、この Range("C6:Y125") の先頭はタイトル行ですか? データ行ですか? →いいえ、最初からそうだったんです。すいません。すべてデータの行で5行目がタイトル行です。 並び替えを実行する際には 対象領域の先頭がタイトル行なのか、データ行なのかを Header:= で指定します。 アップされたそちらのコードでは、この指定がないですが? (指定がない時には 先頭はタイトルではなくデータだとみなされます。それでいいならいいのですが) →この辺りからβさんの言葉が????? そうそう、そちらは xl2016 なんですよね? で、コードの参考として並び替え操作をマクロ記録したんですよね? マクロ記録で Sortメソッド版が生成されるのは xl2003 まで、xl2007以降は Sortメソッドも使えますが マクロ記録すると 新しい Sortオブジェクトをベースにしたコードが生成されるはずなんですが? それとも(当方、xl2016 を持っていないのでわかりませんが)xl2016 ではマクロ記録で Sortメソッド版のコードが 生成されるのでしょうか? →????? すみません。決してふざけているわけではないのですが・・・ (だいちゃん) 2016/12/09(金) 22:37 ---- シート(データ入力)は保護解除状態から早速、上書きして実行して、並び替えボタンを押すと、  実行時エラー1004 が出てしまいました。 (だいちゃん) 2016/12/09(金) 22:48 ---- コメントアップしようとしたら、そちらの書き込みがあったので、まず、そちらから。 >>実行時エラー1004 実行マクロコードを、そのままの形でコピペでアップしてください。 それと、その中の、どこコードで 1004 になったのかも教えてください。 さらに、1004 とともにメッセージが出ているはずですが、そのメッセージ内容も正確に教えてください。 →エラー「Rangeクラスの Sortメソッドが失敗しました。」 で、あらためて。 >>これはどこに入れればよいのですか? 現在の Sub SortTest1() から End Sub までを消して、こちらがアップしたものをすべて、つまり Sub SortTest1()    '    ' End Sub Sub ReProtect(sh As Worksheet)    '    ' End Sub を貼り付けるということです。 →上書きで貼り付けました。 少し疲れてきました・・・・・・ →申し訳ありません。 レイアウトの件はわかりました。 で、並び替えコードの件は難しいことを言っているわけではないんです。 そちらから、アップされたコードの中に .Sort という部分があって、もし、マクロ記録をして それを参考にしたなら、こんなコードはマクロ記録では出来上がらない、もしかしたら エクセルは 2003なのかなと。 でも、最初の質問文の一番最後に Excel2016 と書いてあったので。 で、そちらのエクセルバージョンは? →Excel2016です。間違いありません。 ★明日、夕方から旅に出ます。戻りは 月曜日の夜。  旅に出る前にかたがつかなかったら、火曜日以降しかフォローできません。 →良き旅を〜♪ (β) 2016/12/09(金) 22:53 ---- >>実行マクロコードを、そのままの形でコピペでアップしてください。 >>それと、その中の、どこコードで 1004 になったのかも教えてください。 このようにお願いしてます。よろしく。 私がコードをアップする前の形で、そちらで実行してエラーになったわけですから、その、そちらのコードをそのままアップして どのプロシジャのどのコードでエラーになったのかを教えてください。 ★想像はできます。SortTest1 のみサンプルアップしました。  SortTest1 は シートの保護を外し(そちらのテスト時は、保護をはずしてやっているようですけど)  処理後、「再保護」をかけています。(それは、そちらの要望に応えたわけで、かつ、これまでの説明でわかっていますよね)  で、おそらく、そのあと SortTest2 を実行? SortTest2 については、こちらからはなにもアップしていないので  そのまま実行? シートは SortTest1 で保護がかかっています。それに対して、保護解除しない、そちらのSortTest2を実行すれば  1004 のエラーになるのは、当たり前ですよね? (β) 2016/12/09(金) 23:57 ---- >この表は基になるもので、直接入力しています。 >ただ、これを保護をかけて使う方法はあるのでしょうか? 表の範囲は、ロックしていないのですよね。 なら、シート保護のオプションで、並べ替えにチェックをいれれば、 マクロでシート保護を解除しなくても、そのまま使えませんか。 (マナ) 2016/12/10(土) 09:41 ---- >>ただ、これを保護をかけて使う方法はあるのでしょうか? マナさんからコメントが出ています。 シート保護のことについては だいちゃんさんが熟知していて 当該シートのセルで必要なところはセルロックを外したうえで適切なシート保護条件をセットしているという前提で。 並び替えだけであれば、マナさん指摘のように、並び替えを許可すればOKになると思います。 ただし、今後、いろんなマクロ処理を追加していったときに、シート保護のままでは、不可能な変更もでてきます。 たとえば入力規則。解除はできるのですが、設定ができなかったり。 ですから、安全で簡単なのは、セル変更前に解除、変更後、保護条件を継承して保護。 これがいいと、βは思っています。 (β) 2016/12/10(土) 10:02 ---- ところで、アップした ReProtect ですが、ちょっと不具合がありました。 以下で置き換えておいてください。 Sub ReProtect(sh As Worksheet) '現在の保護要素を継承したシート再保護 Dim pp As Protection Dim sv As Long With sh '対象シート sv = .EnableSelection Set pp = .Protection .Protect 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/10(土) 10:05 ---- ありがとうございます。 これ以降は、週明け火曜日以降ですね。 よろしくお願いします。 (だいちゃん) 2016/12/10(土) 11:39 ---- >>これ以降は、週明け火曜日以降ですね。 出発は夕方ですから、何かあればそれまでの間、フォローはできるかもしれません。 それより、こちらの質問、依頼、確認 等に対しては、きちょんとレスくださいね。 たとえば >>実行時エラー1004 (β) 2016/12/09(金) 23:57 の ★印で、想像していることがありますが、これはどうだったんですか? この通りなら、原因を調べなくともいいわけですし、そうじゃなかったら原因は他にあるわけで、まだまだ調べなきゃいけませんので。 あと、「エンターで自動実行」ということについても、 どのシートの何をいれてエンターしたら土の処理を自動実行したいのか 具体的に説明してください。 それと、ボタンを貼り付けているシート、抽出月を入力するシートは、どのシートなのかも 説明してくださいね。 先ほど解決した別トピでもそうでしたけど、情報は小出しにしないですべて 説明してくださいね。 (β) 2016/12/10(土) 11:47 ---- 私も土曜日のお昼前から泊りで出かけておりましたため、今の時間の回答となってしまいました。 また、質問するにしてもきちんとした情報提供ができておらず、申し訳ありません。 今後、気を付けていきます。どうぞよろしくお願いします。 >ところで、アップした ReProtect ですが、ちょっと不具合がありました。 以下で置き換えておいてください。 というのは、以下のようになりますか?(標準モジュールの構文すべて) Sub SortTest1() Worksheets("データ入力").Activate Worksheets("データ入力").Range("C6:Y125") _ .Sort Key1:=Worksheets("データ入力").Cells(6, 4), order1:=xlAscending, _ Key2:=Worksheets("データ入力").Cells(6, 7), order2:=xlAscending End Sub Sub ReProtect(sh As Worksheet) '現在の保護要素を継承したシート再保護 Dim pp As Protection Dim sv As Long With sh '対象シート sv = .EnableSelection Set pp = .Protection .Protect 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 Sub SortTest2() Worksheets("データ入力").Activate Worksheets("データ入力").Range("C6:Y125") _ .Sort Key1:=Range("D6"), order1:=xlAscending, _ Key2:=Range("G6"), order2:=xlAscending End Sub Sub SortTest3() Worksheets("データ入力").Activate Worksheets("データ入力").Range("C6:Y125") _ .Sort Key1:=Range("H6"), order1:=xlAscending, _ Key2:=Range("D6"), order2:=xlAscending End Sub >あと、「エンターで自動実行」ということについても、 どのシートの何をいれてエンターしたら土の処理を自動実行したいのか 具体的に説明してください。 データ入力シートの日付を入力してエンターを押したら、実行という形にできればと思っています。 ただ、マクロのボタンを作って、それを押した時点で並び替えというのもありなのかなと今は考えています。 >それと、ボタンを貼り付けているシート、抽出月を入力するシートは、どのシートなのかも 説明してくださいね。 現在は、データ入力シート最上部に日付順、名前順という形のボタンを作成しています。これはこれでおいておいて、別シートにも同じボタンを置いて実行させたいのですが、一度試してやってみると、ボタンを押した時点でデータ入力シートに飛ぶんです。これを飛ばないようにしたいです。場合によっては、その他のシートにも波及させて、データ入力シートにいかずとも、それぞれのシートで並び替えを実行できたらなと自分の中では想像しています。 (だいちゃん) 2016/12/11(日) 22:19 ---- さきほど帰宅。 (β) 2016/12/09(金) 23:57 と (β) 2016/12/10(土) 11:47 で 実行時エラー 1004 について 問いかけていることがあります。  回答よろしく。 (β) 2016/12/12(月) 20:47 ---- (だいちゃん) 2016/12/11(日) 22:19 について 簡単に。 >>以下のようになりますか?(標準モジュールの構文すべて) (β) 2016/12/09(金) 21:27 で、SortTes1 についてのみサンプルとしてコードを提示しました。 この SortTest1 では、処理前にシートの保護を解除し、処理が終わってから、そのシートを再保護しています。 あわせて、再保護プロシジャもアップしたわけです。 当然、これはサンプルですから、SortTest2 や SortTest3 も SortTest1 の形にしてもらわなければいけないのですが 「これでいいですか」というコードには、その SortTest1 も含めて、全く反映されていませんねぇ・・・?? なぜですか? それと・・・SortTest1 と SortTest2 は、全く同じコード(記述が Range か Cells か だけの違い) これってなぜ、この2つがあるんですか? さらに、これは前から思っているんですが、SortTest3 って、別シートに抽出したデータの並び替えでしょ? なぜ、データ入力シートの並び替えになっているんですか? >>データ入力シートにいかずとも、それぞれのシートで並び替えを実行できたらなと すべてが片付いたら、当然、最終形としては、そのようにもっていきましょう。 いまは、まず、(処理中にシートが動こうが動くまいが)正しく処理されるというところを達成しましょう。 今は並び替えだけですが、この先、条件による抽出も必要ですから。 それらが、すべて終わってからにしましょう。 >>エンターしたら・・・ 最終的にはボタン起動でも可能、抽出月を入力してエンターして自動起動も可能。 どうするかは、だいちゃんさん が選択可能 という形にします。 でも、それも、最後にです。 まずは、こちらの問いかけに答えていただき、並びかえをを早く卒業しましょう。 (β) 2016/12/12(月) 21:00 ---- こんばんは。 早速ですが、実行時エラー1004についての回答をする前に確認させていただきたいことがあります。 モジュールの修正が反映されていないということで、実際どこにどのように上書きさせればよいのかがわからなくなってしまっていて・・・すみません。 (だいちゃん) 2016/12/12(月) 22:19 ---- いやぁ・・・・ アドバイスをしようにも、今、コードがどうなっていて、そのコードを実行した時に、どのコードで 1004エラーになったのか それがわからないと、先に進めないんです。 こちらが提示したコードに何かバグがあったのか、そうではなく、単に、保護されているシートで、そのまま 並び替えを行ったのか。(保護シートで並び替えを行えばエラーになるということは、もうわかっているわけですよね) ですから、こうだったと言ってもらえれば、この先に進めるわけです。 正直、現在の並びかえだけで、なぜ、こんなに、先に進むのに苦労するのか、それがわかりません。 現在の標準モジュールのコードをすべて消して、以下を貼り付けて実行してみてください。 Sub SortTest1() Worksheets("データ入力").Activate ActiveSheet.Unprotect Range("C6:Y125").Sort Key1:=Range("D6"), order1:=xlAscending, _ Key2:=Range("G6"), order2:=xlAscending 'シート保護解除前に設定されていた保護条件を継承して再保護 ReProtect ActiveSheet End Sub Sub SortTest2() Worksheets("データ入力").Activate ActiveSheet.Unprotect 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 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/12(月) 22:41 ---- すみません。 ご指示のコードを上書きして、シートの保護を解除した状態で実行したところ、 SortTest1()、SortTest2()ともに並び替えが行われました! 実行時エラー1004は出現しません。すごい!! (だいちゃん) 2016/12/12(月) 22:48 ---- >>シートの保護を解除した状態で実行したところ もし、そうするのであれば、いままでのやりとりは、とんだ回り道だったということになります。 シート保護かかかっていなければ、今回のケース、最初から、1004エラーにはならなかったわけですから。 あくまで、保護されたシートに対して処理したい、そういう要望があったから、シート保護状態でも1004エラーにならないコードをアップしたわけです。 まぁ、アップしたコードの実行後は、シートには保護がかかっていますので、 その状態で、もう一度 やってください。 で、それでもエラーにならないということを確認してください。 次に、なぜエラーにならないかを、コードをよく見て理解してください。 理解が得られたら残りのテーマに進みましょう。 (β) 2016/12/12(月) 22:55 ---- βさん、すごいですね。 シート保護(パスワードあり)の状態から、SortTest1()を実行したところ、パスワード解除を求められます。 パスワードを入力してエンターを押すと並び替えが実行されます。 保護はかかったままですが、パスワードなしの状態で、SortTest2()を実行すると並び替えが実行されます。 (だいちゃん) 2016/12/12(月) 23:03 ---- パスワードがかかっていない前提で、パスワードがかかっていれば、PassWord:="なんとか" を加えてくださいと 何度も申し上げていますけど・・・・・ 保護解除は ActiveSheet.Unprotect PassWrod:="なんとか" 再保護は(以下は、「とりあえず」の構文です。最終的には汎用的に使えるように構成をかえます) .Protect PassWrod:="なんとか", Contents:=True, _ にしてください。 (β) 2016/12/13(火) 07:25 ---- おはようございます。 理解がとぼしく申し訳ありません。 以下のように修正して、実行したところ、実行時エラー1004が現れました。 これは、1と2いずれもです。 今から仕事に出ます。よろしくお願いします。 Sub SortTest1() Worksheets("データ入力").Activate ActiveSheet.Unprotect PassWrod:="00001" Range("C6:Y125").Sort Key1:=Range("D6"), order1:=xlAscending, _ Key2:=Range("G6"), order2:=xlAscending 'シート保護解除前に設定されていた保護条件を継承して再保護 ReProtect ActiveSheet End Sub Sub SortTest2() Worksheets("データ入力").Activate ActiveSheet.Unprotect PassWrod:="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 PassWrod:="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/13(火) 07:46 ---- .Protect PassWrod:="00001", Contents:=True, _ ごめんなさいね。コードアップ時手打ちをしてしまいました。 .Protect PassWord:="00001", Contents:=True, _ にしてください。 (β) 2016/12/13(火) 08:19 ---- ↑ この手当てで、「長かった」並び替え対応Q/Aも終了すると思います。 次は入力データシートから別シートへの抽出というテーマに進むわけで ピボットであれフィルターオプションであれオートフィルターであれ、これも、実際の操作をマクロ記録して それをチューニングするトライは続けていただきたいと思います。 一方、たとえば こちらがアップしたフィルターオプションの手順、シートレイアウトがかわっているので、 対応領域はもちろん変わりますが、その特定方法も変更が必要になってきます。 そういうところも、Q/Aを継続して、できるだけ、丸投げ/丸受け ではない形で進めたかったんですが 「参考」として、処理の完成版コード案をアップしておきます。 以下の前提です。 ・元シートは "データ入力"、そこから抽出して結果を並び替えるシートを "抽出" にしています。 ・抽出する月の数字を操作者が入力するわけですが、それを データ入力シートの F1 にしています。 ・フィルターオプション抽出条件セット欄として データ入力シートの H1:H2 を使います。  (もしかしたら、操作者が指定する月の入力は、データ入力シートでも、抽出して転記するシートでもなく別シートかもしれませんね) このあたりは、★印をつけてありますので、実際の名前や、希望の領域に変えてください。 なお、アップした手順案では条件セット欄に前もって記入してもらう方法でしたが、以下では マクロ内で自動セットしますので準備不要です。 ・データ入力シート、抽出シート ともに シート保護がかかっている、それを自動解除し  処理後、再保護をかけます。 ・シートにはパスワードがかかっている。そのパスワード文字列に関しては実際の値に変更してください。 ●重要な前提条件を忘れていたので追記します。  フィルターオプションを使います。タイトル行が【命】です。  データ入力シートの5行目のC列からY列まですべて、ユニークなタイトル文字列が入っているということが必要です。 Sample1 が データ入力シートの並び替え(今まで TestSort1 となっていた部分) Sample2 が データ入力シートから指定月データを抜出し 抽出シートに転記した上で並び替える処理です。 (並び替え部分は今までのTestSort2の抽出シート版)  それぞれのボタンに登録してください。 シートのActivate等、一切のシートの表示切替は行っていませんので、ボタンを押したシートは、最後まで そのまま、動かずに表示されます。 今までのコードをすべて消し、以下を標準モジュールに貼り付けてください。 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 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 「エンターしたら即座に」というのは Sample2 のほうですかね? 指定月を入力してエンターしたら、自動的に抽出、転記 ということをやりたければ、さらに以下を。 (この場合、Sample2 を動かすボタンは不要。といか、ボタン起動はやめてください) 月数字を指定するシート(データ入力シートだと思いますが)のシートタブを右クリックしてコードの表示を選んで でてくるところに以下貼り付け。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(False, False) <> "F1" Then Exit Sub '★ Select Case Target.Value Case 1 To 12, Empty Application.EnableEvents = False Call Sample2 Application.EnableEvents = True Case Else MsgBox "月は 1から12の範囲で指定してください" End Select End Sub (β) 2016/12/13(火) 08:25 ---- PassWrod → PassWord に修正したところ、うまく動きました!! ここからは仕事で返信はできないと思います。 また夜に確認させていただきます。 何卒よろしくお願いします。 (だいちゃん) 2016/12/13(火) 08:28 ---- なお、本件に限らず、だいちゃんさんが 質問をして回答者とやり取りする場合、 1004エラーです といったものだけでは不十分です。 どのコードでエラーになったのか、そのときに同時に出ていたメッセージ文言は何だったか。 これが、やりとりする上での必須条件です。 今後の参考として申し上げておきます。 (β) 2016/12/13(火) 08:30 ---- はい、よろしくお願いします。 (だいちゃん) 2016/12/13(火) 20:50