[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『並べ替えを自動化させたい』（だいちゃん）
シート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 ＞
シート１の並び替え、操作はできますよね、もちろん。 その操作をマクロ記録すれば、基本となるコードが生成されます。 あとは、コード内で固定になっているセル領域を変数化すればいいのですが、 まず、そこまでやって、変数化が自分ではできなかったら、継続して質問されてはいかがですか。
シート２の件については、関数でもできるんでしょうけど、シート１にオートフィルターを設定して 抜き出して、その結果をシート２にコピペして並び替え、
あるいは シート１からフィルターオプションで直接シート２に抽出して並び替え。
必要ならこういった操作をマクロ記録して、マクロ対応されたらいいのでは？
（β） 2016/12/08(木) 21:31
（γ） 2016/12/08(木) 21:48
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
もろかぶりですが。
２つ考えられます。
１．同じモジュールに 同じ名前を持つプロシジャを書くことは許されていません。 一方の名前を変えましょう。
２．１行のコードが長くなった場合に見づらいので、適宜 半角スペース と _ を継続マークとして 行を変えてコーディングすることができますが、コードの最後に 継続マークをおいてはいけません。
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 リストの最初のデータ（２行目）の抽出条件式です。
で、抽出シート(Sheet2) のセルをクリアして空白にしておきます。
このH1:H2 は実行時には非表示でも構いませんので、H列を非表示にしておいたほうがいいかもしれません。
できあがったマクロを、実行時にどのシートがあるてぃぶになっていても問題ないように SHeet1 を選択してから 以下の操作を開始してください。
●操作（マクロ記録）
１．Sheet2 を選択 ２．データタブ 詳細設定 ３．でてきたダイアログで １）リスト範囲(L) を Sheet1 の A列:D列 ２）検索条件範囲(C) を SHeet1 の H1:H2 ３）指定した範囲(O) を選び、抽出範囲(T) に Sheet2 の A1:D1 ４）ＯＫボタン
SHeet1 の F1 に抽出月の数字を入力して、このマクロを実行すると、目的のデータが抽出されます。
（β） 2016/12/09(金) 12:03
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
SortTest1 も SortTest2 も、それぞれ【危うさ】を内包しています。
●SortTest1
関連の対象セル領域にシート修飾をしている、そのことは、非常に素晴らしいのですが ２か所、うっかり部分があります。
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
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
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 のほうは １行目がタイトル行じゃなかったですか？ レイアウトを変えて両方、６行目をタイトル行にしたんですか？
もし、そうなら、私がアップしたフィルターオプションの手順の中の指定セル領域も変わってきますよ。
６行目からでもいいのですが、そうであれば、それなりに 操作もコードも面倒になります。 両方、１行目をタイトル行にすることを、強くおすすめします。
あぁ、それと、領域記述は Range でも Cells でもいいわけですが、１つの命令文の中に Range と Cells が混在するのは （それが、指定上必要な場合もありますが）あまり見やすいとは言えません。
（β） 2016/12/09(金) 15:03
エラーは、1004 ではなく、400 なんですね？
この２つのコード、これらは、どのモジュールに書いてありますか？
もし、どこかのシートのシートモジュールに書いてあるとすれば、それを消して 標準モジュールに書いて試してみてください。
(ただ、そうだった場合、 SortTest1 はエラーにならないはずなので、？？？ ですけど・・）
（β） 2016/12/09(金) 15:25
このシートに保護がかかってるなんてことはないですか？
（β） 2016/12/09(金) 15:48
（だいちゃん） 2016/12/09(金) 16:48
再び保護する時、
Sheets("データ入力").Protect Password:="パスワードを書く"
（おせっかい） 2016/12/09(金) 17:02
（だいちゃん） 2016/12/09(金) 17:12
保護がかかっているシートをマクロで変更する場合、２つの方法があります。
１．マクロで書きこむ前に保護を解除、マクロで書き込みが終わったら、再保護。 これが一番確実で楽です。
ただし、この場合、再保護で留意すべき点があります。 シート保護の状態は様々です。手動でシート保護をかける際に、このシートのすべてのユーザーに許可する操作 というのがありますね。その様々な操作で許可したいものをチェックした上で保護を掛けるわけですが、
Sheets("データ入力").Protect Password:="パスワードを書く"
このコードの場合、Protect に対して、どの操作を許可するか、全く指定がないですね。 その場合、設定は、規定値となります。つまり許可する操作は ロックされたセルの選択とロックされていないセルの選択のみ。 その他の操作は禁止になります。仮に、このシート保護時、他の操作も許可してあったとしてもそれらが禁止されます。
回避する方法 これとこれは、このシートでは許可して保護をかけているということがわかっていれば（わかっていると思いますが）
Sheets("データ入力").Protect の引数として、それらの許可を明示的に与える。
どう与えればいいのかということについては、実際に、それら条件を許可して保護する操作をマクロ記録すれば
コード生成されまますので、それを、そのまま取り入れたらいいです。
２．ブックを開くときに、「特別な保護」をかけます。これは、保護のままで、でもマクロからは、かなりのことができるという保護です。 ただ、「かなりのことができる」というものの万能ではありません。変更の内容によっては、エクセルから、だめだよと叱られることもあります。 かつ、許可する操作については前述と同じです。これとこれを許可と明示的に指定するか、あるいは、今かかっている保護条件をすべて引き継ぐ というコードにする必要があります。現在の条件を引き継ぐ ということなら、そのコードをアップしてもよろしいのですが すでにコメントしたように万能ではないので、１．の方式をおすすめします。
>>あとは、この二つのマクロをEnterを押して実行という構文なのですが、
これは、すべてが完成した後に考えましょう。一歩ずつがベストです。
（β） 2016/12/09(金) 17:29
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
コードはすべて Sub と End Sub の間に記述しなければいけません。 アップされたように その中から外れてコードを書くとコンパイラーから叱られます。
叱られたときに出てくるメッセージを、ちゃんと読めば、そういったことが表現されていますよ。
とりあえず、SortTest1 をもとにサンプルです。
最初に Worksheets("データ入力").Activate としていますので ActiveSheet が データ入力シート ですね。
本来はシート修飾して、状況依存にはならない安全なコードを書くのが望ましいのですが、今、それに踏み込むと
混乱すると思いますので、このままの形（つまり、目的のシートは ActiveSheet）で。
シートの再保護は、SortTest1 の中に組み込んでもいいのですが、あえて別だてでサブプロシジャ化して、SortTest1では それを１行のコードを書くことで実行しています。 SortTest1 以外でも、再保護をかけるときは、同様に １行の呼び出しコードで書くことができます。
なお、シート保護にパスワードがかかっていないというコードです。 パスワードが設定されているなら 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
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) の部分も忘れないように。
ところで、当初、そちらからアップされたレイアウトは、１行目、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) の部分も忘れないように。
→これはどこに入れればよいのですか？
ところで、当初、そちらからアップされたレイアウトは、１行目、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
>>ただ、これを保護をかけて使う方法はあるのでしょうか？
マナさんからコメントが出ています。
シート保護のことについては だいちゃんさんが熟知していて 当該シートのセルで必要なところはセルロックを外したうえで適切なシート保護条件をセットしているという前提で。
並び替えだけであれば、マナさん指摘のように、並び替えを許可すればＯＫになると思います。 ただし、今後、いろんなマクロ処理を追加していったときに、シート保護のままでは、不可能な変更もでてきます。
たとえば入力規則。解除はできるのですが、設定ができなかったり。
ですから、安全で簡単なのは、セル変更前に解除、変更後、保護条件を継承して保護。
これがいいと、βは思っています。
（β） 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
>>これ以降は、週明け火曜日以降ですね。
出発は夕方ですから、何かあればそれまでの間、フォローはできるかもしれません。
それより、こちらの質問、依頼、確認 等に対しては、きちょんとレスくださいね。
たとえば
>>実行時エラー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 か だけの違い） これってなぜ、この２つがあるんですか？
さらに、これは前から思っているんですが、SortTest3 って、別シートに抽出したデータの並び替えでしょ？ なぜ、データ入力シートの並び替えになっているんですか？
>>データ入力シートにいかずとも、それぞれのシートで並び替えを実行できたらなと
すべてが片付いたら、当然、最終形としては、そのようにもっていきましょう。 いまは、まず、（処理中にシートが動こうが動くまいが）正しく処理されるというところを達成しましょう。
今は並び替えだけですが、この先、条件による抽出も必要ですから。
それらが、すべて終わってからにしましょう。
>>エンターしたら・・・
最終的にはボタン起動でも可能、抽出月を入力してエンターして自動起動も可能。 どうするかは、だいちゃんさん が選択可能 という形にします。 でも、それも、最後にです。
まずは、こちらの問いかけに答えていただき、並びかえをを早く卒業しましょう。
（β） 2016/12/12(月) 21:00
いやぁ・・・・
アドバイスをしようにも、今、コードがどうなっていて、そのコードを実行した時に、どのコードで 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
（だいちゃん） 2016/12/12(月) 22:48
>>シートの保護を解除した状態で実行したところ
もし、そうするのであれば、いままでのやりとりは、とんだ回り道だったということになります。 シート保護かかかっていなければ、今回のケース、最初から、1004エラーにはならなかったわけですから。
あくまで、保護されたシートに対して処理したい、そういう要望があったから、シート保護状態でも1004エラーにならないコードをアップしたわけです。
まぁ、アップしたコードの実行後は、シートには保護がかかっていますので、 その状態で、もう一度 やってください。
で、それでもエラーにならないということを確認してください。
次に、なぜエラーにならないかを、コードをよく見て理解してください。
理解が得られたら残りのテーマに進みましょう。
（β） 2016/12/12(月) 22:55
（だいちゃん） 2016/12/12(月) 23:03
パスワードがかかっていない前提で、パスワードがかかっていれば、PassWord:="なんとか" を加えてくださいと 何度も申し上げていますけど・・・・・
保護解除は
ActiveSheet.Unprotect PassWrod:="なんとか"
再保護は（以下は、「とりあえず」の構文です。最終的には汎用的に使えるように構成をかえます）
.Protect PassWrod:="なんとか", Contents:=True, _
にしてください。
（β） 2016/12/13(火) 07:25
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
↑ この手当てで、「長かった」並び替え対応Ｑ／Ａも終了すると思います。
次は入力データシートから別シートへの抽出というテーマに進むわけで ピボットであれフィルターオプションであれオートフィルターであれ、これも、実際の操作をマクロ記録して それをチューニングするトライは続けていただきたいと思います。
一方、たとえば こちらがアップしたフィルターオプションの手順、シートレイアウトがかわっているので、 対応領域はもちろん変わりますが、その特定方法も変更が必要になってきます。
そういうところも、Ｑ／Ａを継続して、できるだけ、丸投げ／丸受け ではない形で進めたかったんですが 「参考」として、処理の完成版コード案をアップしておきます。
以下の前提です。
・元シートは "データ入力"、そこから抽出して結果を並び替えるシートを "抽出" にしています。 ・抽出する月の数字を操作者が入力するわけですが、それを データ入力シートの F1 にしています。 ・フィルターオプション抽出条件セット欄として データ入力シートの H1:H2 を使います。 （もしかしたら、操作者が指定する月の入力は、データ入力シートでも、抽出して転記するシートでもなく別シートかもしれませんね）
このあたりは、★印をつけてありますので、実際の名前や、希望の領域に変えてください。 なお、アップした手順案では条件セット欄に前もって記入してもらう方法でしたが、以下では マクロ内で自動セットしますので準備不要です。
・データ入力シート、抽出シート ともに シート保護がかかっている、それを自動解除し 処理後、再保護をかけます。 ・シートにはパスワードがかかっている。そのパスワード文字列に関しては実際の値に変更してください。
●重要な前提条件を忘れていたので追記します。 フィルターオプションを使います。タイトル行が【命】です。 データ入力シートの５行目のＣ列からＹ列まですべて、ユニークなタイトル文字列が入っているということが必要です。
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
なお、本件に限らず、だいちゃんさんが 質問をして回答者とやり取りする場合、
1004エラーです といったものだけでは不十分です。
どのコードでエラーになったのか、そのときに同時に出ていたメッセージ文言は何だったか。 これが、やりとりする上での必須条件です。
今後の参考として申し上げておきます。
（β） 2016/12/13(火) 08:30
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.