Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 7 Professional : 指定なし)
【至急】オートフィルタ後のマクロ実行
投稿日時: 17/12/05 20:48:46
投稿者: millulillu

お世話になります。
 
現在、ガントチャートを表(テーブルは使用していません)と矢印(ライン)で作成し、
ユーザー入力のタイミングで矢印が再描写されるようにしています。
 
オートフィルタ後の再描写についてご教示いただけないでしょうか。
 
抽出や、昇順、降順の並び替えを行うのですが
オートフィルタが設定されているのは表だけのため、
横並びのカレンダー部分はそのままの状態です。
 
抽出は行が非表示となり、矢印の再描写は不要ですが
ソート後のタイミングでは再描写を実行しなれけばなりません。
 
苦肉の策でSelectionChengeで表のアドレスを見て再描写をかけていますが
そのイベントですと、セル選択でも再描写が実行されてしまったり
表の一部が抽出されていると毎回アドレスが変わってしまうため動作が安定せず困っています。
 
フィルタ実行イベントの代替え策はないでしょうか。
ご教示お願いします。
 
----------------------------------------------------------------------------
  項目 │ 開始日 │ 終了日 │ 1日 │ 2日 │ 3日 │ ・・・・・
----------------------------------------------------------------------------
      12/2    12/3        ----------------> 

回答
投稿日時: 17/12/05 20:59:32
投稿者: もこな2

状況がよくわからないですけど、

millulillu さんの引用:
苦肉の策でSelectionChengeで表のアドレスを見て再描写をかけていますが
そのイベントですと、セル選択でも再描写が実行されてしまったり
表の一部が抽出されていると毎回アドレスが変わってしまうため動作が安定せず困っています。
これって、Target.Rangeが特定のセル範囲でなければ、Exit Sub で抜けるとかはだめです?要は特定のセル範囲にフォーカス動かしたときだけ動く みたいな・・・

回答
投稿日時: 17/12/05 22:07:30
投稿者: WinArrow
投稿者のウェブサイトに移動

>矢印(ライン)
は、図形の「線」ですよね?
 
図形はセルの付属物ではないから
オートフィルタの対象外です。
 
図形でなければいけないのかな?
 
セルに「━」を入れるとか、背景色を変えるとか・・・・こちらの代案を考えた方がよいでしょう。

投稿日時: 17/12/05 23:24:57
投稿者: millulillu

引用:
これって、Target.Rangeが特定のセル範囲でなければ、Exit Sub で抜けるとかはだめです?要は特定のセル範囲にフォーカス動かしたときだけ動く みたいな・・・

 
もこな2さん、ありがとうございます。
 
再描写は値変更とソート時以外は避けたいです。
 
WinArrowさん、ありがとうございます。
 
カレンダーもフィルタ範囲に含めてしまえばいいのですが
日付の列は日付が見えるギリギリの幅に設定しており、
フィルタをかけてボタンが表示されると
全体を見渡す際に邪魔なんです。
 
図形でなければいけない理由は、1行に計画と実績を
表示させているためです。
 
現状のままなんとかできないでしょうか?
よろしくお願いします。
 
 
 

回答
投稿日時: 17/12/06 10:07:13
投稿者: WinArrow
投稿者のウェブサイトに移動

最初の矢印(図形)を、マクロで実行しているんでしたら、
同じロジックを使えばよいでしょう。
(最初に作成した図形は、削除して、・・・・)
 
最初に手動作成の図形を使おうとしているならば、
セルと図形のリンク情報を取得し、相対位置で移動する方法がありますが、
条件が複雑になります。

回答
投稿日時: 17/12/06 11:46:20
投稿者: もこな2

ごめんなさい。私の読解力がないのか、今ひとつわからないままです。
たとえば、フィルターの話であれば
----------------------------------------------------------------------------
  項目 │ 開始日 │ 終了日 │ 1日 │ 2日 │ 3日 │ ・・・・・
----------------------------------------------------------------------------
      12/2    12/3        ---------------->
      12/2    12/3
      12/3    12/4        ---------------->
      12/2    12/3
っていうのを、開始日:12/3 にしたら、こうなってほしいってことですよね?
----------------------------------------------------------------------------
  項目 │ 開始日 │ 終了日 │ 1日 │ 2日 │ 3日 │ ・・・・・
----------------------------------------------------------------------------
      12/3    12/4        ---------------->
 
これは、シェイプを何にもしなくても、フィルタ外の行は表示されないので、希望の動作しません?
 
 
次に昇順、降順(=ソート)ですが、「並べ替え」やSortメソッドだと、シェイプは移動されないですけど、行をまるごと切り取って、逆順(※)で表の最初の行に挿入すればいけると思うんですが・・・・
 
(※)1,2,3って並べたいときは、3,2,1という順番に挿入しないとダメですけど
行単位のカット&ペーストのコードが作れるならどうってことないですよね。
 
参考になれば幸いです。

投稿日時: 17/12/06 12:18:02
投稿者: millulillu

WinArrow さんの引用:
最初の矢印(図形)を、マクロで実行しているんでしたら、
同じロジックを使えばよいでしょう。
(最初に作成した図形は、削除して、・・・・)

 
ありがとうございます!
 
対象範囲にある矢印を一括削除してから日付に合わせて
位置決めし追加しています。
 
そのロジックをフィルタのソート後のタイミングで実行したいのですが
イベントがないためどうしようかという、、、
 
やはりSelectionChangeイベントを使用するしかないでしょうか?

投稿日時: 17/12/06 12:41:20
投稿者: millulillu

もこな2 さんの引用:

 
これは、シェイプを何にもしなくても、フィルタ外の行は表示されないので

 
  
  
ありがとうございます!
  
説明下手で申し訳ないです。
  
抽出の場合は非表示になるため問題ありません。
  
悩みはロジックの内容ではなく、
ロジックを実行したいがイベントがないためどうしよう
ということです(´;ω;`)
  
ソートでは、日付以外の範囲だけが並び変わり
矢印は並び変わる前のままですので、ここで再描写マクロを実行し
並び変わったデータで再度、矢印を引きたいのです。

投稿日時: 17/12/06 12:51:11
投稿者: millulillu

また、フィルタのソートを実行すると
SelectionChangeイベントは発生するため、
現在は再描写のタイミングとして使っていますが
セルを選択する度にマクロが走るため、表示件数が多いと
時間がかかってしまいます。
 
フィルタを実行する際に必ずヘッダーを選択してもらうようにするかも考えましたが、100%じゃないし
なにか抜け道があると思うのですが、なかなから難しいです。

回答
投稿日時: 17/12/06 13:45:29
投稿者: もこな2

引用:
ソートでは、日付以外の範囲だけが並び変わり
矢印は並び変わる前のままですので、ここで再描写マクロを実行し
並び変わったデータで再度、矢印を引きたいのです。
なるほど、行を丸ごと並べ替えるわけでは無いんですね。
ただ、先ほどもコメントしましたけど「並べ替え」やSortメソッドだと、矢印A(シェイプ)は移動されないですけど、カット&ペーストだと、シェイブも一緒に移動してくれるので、ロジック自体を変えてしまえば対応できそうな気がします。
(行を丸ごとでなくても、セル範囲をカット&ペースト(下方向にシフト)すればいいいですよね)
 
引用:
悩みはロジックの内容ではなく、ロジックを実行したいがイベントがないためどうしようということです(´;ω;`)
単純に、コマンド実行ボタンをシート上に配置じゃだめですか?
かっこよくするならユーザーフォームを設計するとかありそうですけど。
 
引用:
また、フィルタのソートを実行すると
SelectionChangeイベントは発生するため、
現在は再描写のタイミングとして使っていますが
セルを選択する度にマクロが走るため、表示件数が多いと
時間がかかってしまいます。
上記のとおりマクロ内容というか発動条件を変えてしませば、SelectionChangeイベントは関係なくなりますよね。
 
また、あえてSelectionChangeイベントを使うというのであれば、ほかにイベントを使っていないのが前提ですが、最終手段としてブック読み込み時に「Application.EnableEvents = False」として普段はイベント止めておいて、必要なときだけ、Trueに変えるスイッチのようなものを作ってしまうとかはどうでしょう?
(ワークシート上にスイッチを配置することはできないですけど(=ワークシート上のオブジェクトをクリックしてもイベントがつぶされているから発動しない)、リボンにマクロを登録しちゃえばいけそうな気がします。このほか、マクロが発動したら、最後にFalseに戻してやることを忘れずに。さらに、ブックを閉じるときはTrueに戻すことを忘れずに)
 
もっと言えば、マクロ実行中は「Application.ScreenUpdating = False」で画面更新とめてしまえば、多少は処理時間短くならないですかね・・・根本的な解決ではないですけど・・・

回答
投稿日時: 17/12/06 17:55:01
投稿者: baoo

まず、最初にmillulilluさんがおっしゃる再描画というのがよくわかりません。
もこな2さんがおっしゃるようにSelectionChangeイベントでTarget.Rangeを調べて
特定のセル範囲の場合に再描画するように組むことを考えれば、
それで再描画されてしまうとおっしゃられているのが分かりません。
 
オートフィルタ実施のタイミングで発生させるイベントですが、
私のアイデアではありませんが、ネットで検索したところとりあえず2つ見つかりました。
1つはSUBTOTAL関数を使用して例えばA列の件数を取得することで、
Worksheet_Changeイベントを発生させる方法。
適当なセルに"=SUBTOTAL(3,A:A)"と入力しておけばA列のオートフィルタで件数が変化するので、
Worksheet_ChangeイベントのTarget.Addressでそのセルかどうか判断すればよいと思います。
もう1つは適当な関数を設置してWorksheet_Calculateイベントを発生させる方法。
1行目にオートフィルタが設定されているとして、適当なセルに"=CountA(A2:A2)"とでも
入力しておけばオートフィルタ実施でイベントが発生するようです。
 
上記2つともイベントが発生することは確認しましたが、他の操作でもそのイベントが
発生するのかは調べていません。
わたしだったらオートフィルタの実施自体しないか、オートフィルタに代わる機能を
実装すると思います。

投稿日時: 17/12/07 00:49:24
投稿者: millulillu

もこなさん、お付き合いいただきありがとうございます><
 

もこな2 さんの引用:
「並べ替え」やSortメソッドだと、矢印A(シェイプ)は移動されないですけど、カット&ペーストだと、シェイブも一緒に移動してくれるので、ロジック自体を変えてしまえば対応できそうな気がします。
(行を丸ごとでなくても、セル範囲をカット&ペースト(下方向にシフト)すればいいいですよね)

 
ここまでは順調にきて、第一段階の納品はしてしまっている為
ロジック自体を作り変える時間はなさそうです。
明日中に第二段階を終わらせなければなりません。。。
 
カット&ペーストでの実装があまりピンときていないのですが
対応する項目を保持しておいてソート後に一致する行に合わせてペーストということでしょうか?
 
もこな2 さんの引用:

単純に、コマンド実行ボタンをシート上に配置じゃだめですか?
かっこよくするならユーザーフォームを設計するとかありそうですけど。

 
日付を入力すればダイレクトに矢印が伸びたり縮んだりを視覚的に見ながら、
計画を立案していくのが目的です。
 
ボタン更新にすれば万事OKだと思いますが
ユーザーが日付を入力してボタン押して〜とその操作を何度も繰り返さなければ
ならないというのは作業効率が悪いです。
 
もこな2 さんの引用:
 
もっと言えば、マクロ実行中は「Application.ScreenUpdating = False」で画面更新とめてしまえば

イベント、再計算、ScreenUpdatingは一時的に止めてロジックを実行していますが
それでも1000件を超えると時間がかかります…
無駄なループになっていないか再度チェックしてみます。
 

投稿日時: 17/12/07 01:01:35
投稿者: millulillu

baooさん、ありがとうございます。
 

baoo さんの引用:
1つはSUBTOTAL関数を使用して例えばA列の件数を取得することで、
Worksheet_Changeイベントを発生させる方法。
適当なセルに"=SUBTOTAL(3,A:A)"と入力しておけばA列のオートフィルタで件数が変化するので、
Worksheet_ChangeイベントのTarget.Addressでそのセルかどうか判断すればよいと思います。

 
SUBTOTALの方は、私の環境ではWorksheet_Changeイベントは発生しなかったです。
 
ちなみに、ソートでは件数が変わらないので
どちらにしてもこのイベントは発生しない?
 
baoo さんの引用:

もう1つは適当な関数を設置してWorksheet_Calculateイベントを発生させる方法。
1行目にオートフィルタが設定されているとして、適当なセルに"=CountA(A2:A2)"とでも
入力しておけばオートフィルタ実施でイベントが発生するようです。

 
こちらは昇順、降順でも確かにイベントが発生しますね!
ありがとうございます。
 
このイベントで通常の再計算とフィルタ実行を見分ける方法はありますでしょうか?
 
また、オートフィルタに代わるようなものというのは
別ボタンでソートを実行するということですよね
やはりそうするしかないでしょうか(^^;

回答
投稿日時: 17/12/07 08:50:22
投稿者: mattuwan44

>抽出や、昇順、降順の並び替えを行うのですが
>オートフィルタが設定されているのは表だけのため、
>横並びのカレンダー部分はそのままの状態です。
 
確認。
↑これは、開始日と終了日の話ですよね?
他の列は関係ないですよね?
ちなみにカレンダーは何日分です?
実例があれば、暇な時に試してみたいのですが。。。急いでいるのは解りますが、
ぱっと、いいアイデアが出る感じでもなさそう。。。今回のバージョンアップには間に合わないかな?
  
>抽出は行が非表示となり、矢印の再描写は不要ですが
>ソート後のタイミングでは再描写を実行しなれけばなりません。
なるほど。。。。
図形の矢印が絶対ですか?
ぼくなら、条件付き書式設定でセルの塗りつぶして対処します。
そうすることで、イベントとかVBAとかで悩まされる心配はないとは思います。
ただし、処理速度の話はここでは別の話です。
こちらで、再現して動作確認出来そうなものでもなさそうですし。。。
 
僕の経験では50行×50列くらいの表では、なんの問題もなかったと記憶しています。
(マクロを開発するより、手動で線を引き直す方がよっぽど気が楽なので^^;
そういうものはいま、作って使ってないので、確実な話でなくてごめんなさい。
まぁ、ソートに対応しようとすれば手動ではなかなか難しいでしょうが。)
 
とりあえず思いつくのは、
ソートの発動は、項目行ダブルクリックで昇順・降順を切り替えたらいいと思います。
(そして、図形の再描写をする)
フィルターは、開始日・終了日の列だけに掛ければいいかと思いますが。。。

回答
投稿日時: 17/12/07 10:41:55
投稿者: もこな2

millulillu さんの引用:
カット&ペーストでの実装があまりピンときていないのですが
対応する項目を保持しておいてソート後に一致する行に合わせてペーストということでしょうか?
いや、ソート後の話ではなくて、ソートの話です。
 
こんな表があって
 ----------------------------------------------------------------------------
1 達成率 │ 開始日 │ 終了日 │ 1日 │ 2日 │ 3日 │ ・・・・・
 ----------------------------------------------------------------------------
2 100%   12/2    12/3        ---------------->
3  30%   12/2    12/3
4  72%  12/3    12/4        ---------------->
5      12/2    12/3
 
@達成率を降順にソートするとなるとこういうのを期待するってことですよね
 ----------------------------------------------------------------------------
1 達成率 │ 開始日 │ 終了日 │ 1日 │ 2日 │ 3日 │ ・・・・・
 ----------------------------------------------------------------------------
2 100%   12/2    12/3        ---------------->
3  72%   12/3    12/4        ---------------->
4  30%   12/2    12/3
5      12/2    12/3
 
Aソートとフィルタと組み合わせると条件は「達成率が0%以外を降順にソート」とかになるはず
 ----------------------------------------------------------------------------
1 達成率 │ 開始日 │ 終了日 │ 1日 │ 2日 │ 3日 │ ・・・・・
 ----------------------------------------------------------------------------
2 100%   12/2    12/3        ---------------->
3  72%   12/3    12/4        ---------------->
4  30%   12/2    12/3
 
このソートするときに、並べ替えやSortメソッドを使うと、矢印(オートシェイプ)が移動してくれないからこまってるのかな?とおもったんで、カット&ペーストなら動きますよって意味で回答しました。
上の例で言えば、
達成率がブランクになっている行を2行目にカット&ペースト(下シフト)
  〃 、30%    〃
  〃 、70%    〃
  〃  100%    〃
を実行すればシェイプごと並べ替えることができますよね。
・・・・・・とおもって、自分の環境(Win7、Excel2013)でテストしてみたら、ただの並び替えでも矢印(シェイプ)移動してくれました。う〜ん逆に何でだろう・・・・
とりあえず、Sortメソッドを使わずにカット&ペースト(下方向シフト)を繰り返すっていうアプローチもあるってことでお納めください。
 
millulillu さんの引用:
日付を入力すればダイレクトに矢印が伸びたり縮んだりを視覚的に見ながら、計画を立案していくのが目的です。
それは、changeイベントのお仕事では?
Target.Rangeが日付欄かどうか判定して、日付欄だったら、Target.Rowのシェイプを削除してから同じ行に新しいシェイプを作ってあげればいいとおもいます。
全部の行の再描写(?)をする必要はないですよね
 
changeイベントは、値が変わらないフィルタ処理には影響ないはず。
(SUMTOTAL関数使ってる場合を除く)

投稿日時: 17/12/07 12:36:31
投稿者: millulillu

ご回答ありがとうございます。
 
まだじっくり読めていませんが、まずはお礼まで。
 
最初に説明すれば良かったのですが、
 
表は、タスク内容、担当者、計画(開始日、必要日数)、実績(開始日、終了日)などが1レコードです。
ソート、抽出は日付だけでなく担当者等でも行います。
 
 
カレンダーには計画を青、実績を赤の矢印で1行に重ならないように配置します
 
オプションとして
カレンダーの表示単位は月、日の2パターンで同じシートの同じ位置に作成します
カレンダーの初日と末日、期間(=列数)はユーザーが自由に決めることができます
行幅と矢印の太さ変更
土日表示、今日・今月の色分け→条件付き書式
 
オプションはシート上にあるリスト選択やセルへの入力から
ダイレクトに反映しています
 
日別では1列が1日のため
矢印の始点は必ずセルの左端、終了は右端になります
 
月別の場合は、開始日が12/15、終了日が12月31日であれば
2017年12月の列とタスク行の交わるセルの中に、中心から右端までの矢印が引かれます。
月をまたぐ時も1列の幅をその月の日数で割った位置に矢印の先端がくるようプログラムしています
 
取り急ぎ、補足でした。
 
後ほど、ゆっくり読ませてください

投稿日時: 17/12/07 12:56:12
投稿者: millulillu

あともう1点
  
この日までにやらないといけない期日が終息日というのですがそれも同行に菱形でポチっとつけてます。
ユーザーはその日まで完了するように必要日数を逆算した開始日をシート上で入力しながら他のタスクとの矢印の重なりを見たりします。
 
担当者抽出ではなくソートしたい理由は、担当者の割合を(個人別の負荷)を、見たいからです。

回答
投稿日時: 17/12/07 13:44:07
投稿者: baoo

millulillu さんの引用:
このイベントで通常の再計算とフィルタ実行を見分ける方法はありますでしょうか?
うーん、確かに他の計算でもイベントが発生してしまいますね。
あまりテクニカルに頑張るのは新たなバグの元になるのであまりお勧めできない、
というより正直これと書くべきか悩ましい、そしてまたネットから探してきたものなのですが、
新たにSheet2を追加してそのSheet2の適当な例えばA1にSheet1のオートフィルタの関連で
計算する適当な関数、例えば"=COUNTA(Sheet1!A2)"等と入力します。
そのSheet2のモジュール上でのWorksheet_Calculateイベントを使えば、
Worksheet1にはWorksheet_Calculateイベントは使用する必要が無くなりますので、
Worksheet1の再計算には反応しなくなります。
余計にSheet2が出来てしまいますが、このイベントの為だけなので非表示にして運用する形になります。

回答
投稿日時: 17/12/07 15:15:23
投稿者: mattuwan44

>悩みはロジックの内容ではなく、
>ロジックを実行したいがイベントがないためどうしよう
>ということです(´;ω;`)
 
あぁ。。。これが本題ですか。。。
セルにActiveXコントロールのコマンドボタンを被せておいて、
クリックとダブルクリックにソートとフィルターの機能をあてがうのはいかがでしょうか?
ソートの状態やフィルターの状態は非表示の別シートに記録しておけばいかがでしょうか?

回答
投稿日時: 17/12/07 15:29:10
投稿者: mattuwan44

あ、作業用のシートを用意しなくても、ボタンの下に隠れてるセルに、
状態を保存しておけばいいですね。。。

回答
投稿日時: 17/12/07 16:44:44
投稿者: mattuwan44

┌─┬──┬─────┬───┬─┬─────────────────────┐
│内│ │ 計画 │ 実績 │ │12月 │
│容├──┼──┬──┼─┬─┼─┼─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┤
│ │担当│開始│日数│開│終│締│ 1│ 2│ 3│ 4│ 5│ 6│ 7│ 8│ 9│10│11│
│ │ 者 │ │ │始│了│切│ │ │ │ │ │ │ │ │ │ │ │
├─┼──┼──┼──┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤
│A │東京│12/1│ 6 │ │ │ │ │ │ │ │ │ │ │ │ │ │ │
│ │太郎│ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │
├─┼──┼──┼──┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤
│B │大阪│12/2│ 4 │ │ │ │ │ │ │ │ │ │ │ │ │ │ │
│ │次郎│ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │
├─┼──┼──┼──┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤
│ │名古│ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │
│C │屋三│12/4│ 6 │ │ │ │ │ │ │ │ │ │ │ │ │ │ │
│ │郎 │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │
├─┼──┼──┼──┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤
│D │東京│12/7│ 4 │ │ │ │ │ │ │ │ │ │ │ │ │ │ │
│ │太郎│ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │
├─┼──┼──┼──┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤
│E │大阪│12/6│ 4 │ │ │ │ │ │ │ │ │ │ │ │ │ │ │
│ │次郎│ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │
└─┴──┴──┴──┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┘
こういう表で、とりあえず計画線を書くコードはこんな感じ?
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Me.Columns("C:D")) Is Nothing Then Exit Sub
    If Target.Row < 3 Then Exit Sub
     
    線クリア Target
    線描写 Target
End Sub
 
Sub 線クリア(Optional ByVal rngTarget As Range = Nothing)
    Dim shp As Shape
 
    If rngTarget Is Nothing Then
        Me.Lines.Delete
    Else
        For Each shp In Me.Shapes
            If Intersect(rngTarget.EntireRow, shp.TopLeftCell) Is Nothing Then
            Else
                shp.Delete
                Exit For
            End If
        Next
    End If
End Sub
 
Sub 線描写(ByVal rngTarget As Range)
    Dim m As Long
    Dim Rng As Range
    Dim c As Range
    Dim rngWrok As Range
 
    Set Rng = Me.Range("A1").CurrentRegion
    Set c = Intersect(Rng.Columns("C"), rngTarget.EntireRow)
 
    On Error GoTo Wayout
    m = WorksheetFunction.Match(c.Value2, Rng.Rows(2), 0)
    On Error GoTo 0
 
    Set rngWrok = Rng(rngTarget.Row, m).Resize(, c.Offset(, 1).Value)
    With rngWrok
        Me.Shapes.AddConnector(msoConnectorStraight, _
                               .Item(1).Left, _
                               .Item(1).Top + .Item(1).Height / 2, _
                               .Item(.Count).Left + .Item(.Count).Width, _
                               .Item(.Count).Top + .Item(.Count).Height / 2).Line.EndArrowheadStyle = msoArrowheadOpen
    End With
Wayout:
End Sub
 
手動でやったら、フィルターも並べ替えもちゃんと矢印がいい感じで表示されているので、
特に困ることはないように思いますが。。。
 
あと、担当者にフィルターをかける部分を別途作ってみます。

回答
投稿日時: 17/12/07 17:27:52
投稿者: mattuwan44

あちゃ、コマンドボタンのクリックを使ったら、ダブルクリックが拾えないのかな^^;
 
寝ながら考えて、解決してなかったら、また何か書くかもです^^;

投稿日時: 17/12/07 20:46:59
投稿者: millulillu

もこな2さん、ありがとうございます。
 
オートフィルタのソート機能を利用しないで並べ替えるって
ことだったんですね!
 
今回はどうしてもオートフィルタでのソートを利用したいのですが
次の機会にはこのやり方での実装も考えてみたいと思います。
 

もこな2 さんの引用:

・・・・・・とおもって、自分の環境(Win7、Excel2013)でテストしてみたら、ただの並び替えでも矢印(シェイプ)移動してくれました。う〜ん逆に何でだろう・・・・

 
色々試してくださってありがとうございます( ;∀;)

回答
投稿日時: 17/12/07 21:37:10
投稿者: もこな2

引用:
オートフィルタのソート機能を利用しないで並べ替えるってことだったんですね!
いや、私が知らないだけかもしれないですけど、オートフィルタはオートフィルタでソートとは別の機能なんじゃないかとおもってて、そこが最初からよくわからないなぁと。
 
私が思うオートフィルタって、フィルタ条件に合致しない行を非表示にしてるだけで行順番は変わらないし、
逆にソートっていうのは、単純に順番に並べてるだけだとおもうんで、オートフィルタのソート機能ってなんなのかなぁと思ってます
 
たとえば
11/23
12/01
12/28
12/03
 
って順番にデータがあったときに、オートフィルタで「12月」ってフィルタ(指定)したら、
12/01
12/28
12/03
って表示されるだけで、
12/01
12/03
12/28
って並べ替えてから表示してくれることはないと思うんですけど私が便利機能を知らないだけですかね。
もしそうだとしたら、ちょと勘違いレスしててごめんなさい。m(__)m

投稿日時: 17/12/07 22:24:50
投稿者: millulillu

もこな2さん、お返事ありがとうございます。
 
オートフィルタのソート機能
 
という表現は適切ではなかったですね
 
申し訳ありません
 
機能とはフィルタのソートのアルゴリズムそのものを言っているのではなく
ソートの実行をオートフィルタのメニューにある、昇順、降順で行う
ユーザーインターフェイスとしての機能?
 
自分で何言ってるかわかんなくなりましたが
これも、的が外れていたらすみません。
 
 
 
 

回答
投稿日時: 17/12/08 08:10:00
投稿者: mattuwan44

>オートフィルタのソート機能
オートフィルターモードの時にタイトル行に出てくる▼を押したときにでる、
プルダウンメニューの中の昇順・降順のことですね。
マクロの記録をしてみると、
 

┌─┬──┬─────┬───┬─┬─────────────────────┐
│内│ 2  │   計画   │ 実績 │  │12月                                      │
│容├──┼──┬──┼─┬─┼─┼─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┤
│  │担当│開始│日数│開│終│締│ 1│ 2│ 3│ 4│ 5│ 6│ 7│ 8│ 9│10│11│
│  │ 者 │    │    │始│了│切│  │  │  │  │  │  │  │  │  │  │  │
├─┼──┼──┼──┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤
│E │東京│12/1│  6 │  │  │  │  │  │  │  │  │  │  │  │  │  │  │
│  │太郎│    │    │  │  │  │  │  │  │  │  │  │  │  │  │  │  │
├─┼──┼──┼──┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤
│D │大阪│12/2│  4 │  │  │  │  │  │  │  │  │  │  │  │  │  │  │
│  │次郎│    │    │  │  │  │  │  │  │  │  │  │  │  │  │  │  │
├─┼──┼──┼──┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤
│  │名古│    │    │  │  │  │  │  │  │  │  │  │  │  │  │  │  │
│C │屋三│12/4│  6 │  │  │  │  │  │  │  │  │  │  │  │  │  │  │
│  │郎  │    │    │  │  │  │  │  │  │  │  │  │  │  │  │  │  │
├─┼──┼──┼──┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤
│B │大阪│12/6│  4 │  │  │  │  │  │  │  │  │  │  │  │  │  │  │
│  │次郎│    │    │  │  │  │  │  │  │  │  │  │  │  │  │  │  │
├─┼──┼──┼──┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤
│A │東京│12/7│  4 │  │  │  │  │  │  │  │  │  │  │  │  │  │  │
│  │太郎│    │    │  │  │  │  │  │  │  │  │  │  │  │  │  │  │
└─┴──┴──┴──┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┘

 
Sub Macro4()
'
' Macro4 Macro
'
 
'
    Range("B2:D7").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("C2:C7"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("F13").Select
End Sub
 
これだと、
オートフィルターが掛かっている範囲、
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Range
しか並び替えがされないので、表全体を対象に並び替えをしないとだめです。
表全体に範囲を拡張して並び替えをしたら、
矢印も、追随して入れ替わってくれるので、「再描写」という手間は省けそうです。

回答
投稿日時: 17/12/08 09:51:21
投稿者: もこな2

mattuwan44 さんの引用:
>オートフィルタのソート機能
オートフィルターモードの時にタイトル行に出てくる▼を押したときにでる、
プルダウンメニューの中の昇順・降順のことですね。
なるほど!めちゃくちゃ合点がいきました。
すっきりした〜 (^_^)

回答
投稿日時: 17/12/08 16:58:39
投稿者: mattuwan44

項目のセルをダブルクリックで昇順・降順切り替え(フラグはふりがなの領域に入れてみました)
右クリックでオートフィルター(▼を消して手動の操作を制限。そのままソートすると表が崩れるので)
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim n As Long
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Me.Range("B2:D2")) Is Nothing Then Exit Sub
    Cancel = True
 
    n = IIf(Target.Phonetic.Text = CStr(xlAscending), xlDescending, xlAscending)
 
    With Target.CurrentRegion
        With Intersect(.Cells, .Offset(1))
            .Sort Key1:=Target, Order1:=n, Header:=xlYes
        End With
    End With
 
    Target.Phonetic.Text = n
End Sub
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim s As String
    Dim i As Long
    Dim Rng As Range
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Me.Range("B2:D2")) Is Nothing Then Exit Sub
    Cancel = True
 
    s = InputBox("キーワード(全データ表示は空白でOK押下)")
    If StrPtr(s) = 0 Then Exit Sub 'キャンセル判定
     
    With Me.Range("A1").CurrentRegion
        Set Rng = Intersect(.Offset(1), .Range("B:D"))
    End With
 
    If Me.AutoFilterMode Then
        On Error Resume Next
        Me.ShowAllData
        On Error GoTo 0
    Else
        Rng.AutoFilter
        For i = 1 To Me.AutoFilter.Range.Columns.Count
            Rng.AutoFilter Field:=i, visibledropdown:=False
        Next
    End If
 
    If Len(s) > 0 Then
        Rng.AutoFilter Field:=Target.Column - 1, Criteria1:=s
    End If
End Sub
 
あとは、応用でお願いします。

投稿日時: 17/12/09 01:06:36
投稿者: millulillu

mattuwan44さん、ありがとうございます
色々アドバイスいただいているにもかかわらず
 なかなか返事ができずすみません
取り急ぎお礼でした!

投稿日時: 17/12/12 19:34:08
投稿者: millulillu

お世話になっております。
  
教えていただいたコードを応用して試行錯誤してましたが
baooさんご提案の別シートのCalculateイベントを利用して
再描画を実行する方法で意図する動きに持っていきたいです。
  
それには課題があり引き続きアドバイスいただけたら幸いです。
  
Sheet1のオートフィルタを実行すると再計算される関数をSheet2の任意セルに設定し、Sheet2のWorksheet_Calculateイベントで矢印の再描画を行います。
  
再描画はソート時のみ実行したいので、グローバル変数に表示件数を保持しておき、sheet2のWorksheet_Calculateイベントが発生した時にsheet1の表示件数との比較で抽出とソートを見分け、ソートなら再描画を実行するようにしています。
  
件数だけだと抽出の時でも保持件数と一致する場合もあるので内容チェックも必要かなと思い、コード追加しなきゃなぁと思いながらなかなか進まずにおります。
  
上記のようなソート時だけに再計算されるような関数は作れないでしょうか?
ユーザー定義関数でも実行すれば必ずCalculateイベントは発生しますので結局同じことでしょうか。
 
もっと簡単に見分ける方法はないでしょうか?

回答
投稿日時: 17/12/12 21:38:41
投稿者: baoo

簡単に現在のオートフィルタの状態をイミディエイトウィンドウに書き出す
サンプルを作ってみました。
適当に作ったので、これ以外のステータスも取得できるはずです。
コード中のブレークの所で一時的に止めて、AFをウォッチウィンドウで
確認してみてください。
その状態でシート上でオートフィルタの状態を変更した後、
ウォッチウィンドウ上でツリーの開け閉めでAFの内容が変化しますので、
その内容で各種ステータスを取得する方法が分かると思います。
そののち、ウォッチウィンドウに表示されるキーワードで
MSDNで調べればその意味も分かるでしょう。
 

Sub Test()
    
    Dim sht As Worksheet
    Dim i As Long
    Dim AF As AutoFilter
    Dim strCriteria As String
    Dim lngCriteria1Num As Long
    Dim lngCriteria2Num As Long
    
    Set sht = ThisWorkbook.Worksheets(1)
    Set AF = sht.AutoFilter
    
    If AF Is Nothing Then                 'ここでブレーク
        Debug.Print "AutoFilterOff"
        Exit Sub
    Else
        Debug.Print "AutoFilterOn"
    End If
    
    'Criteria1
    On Error Resume Next
    strCriteria = AF.Filters(1).Criteria1
    If Err.Number = 0 Then
        Debug.Print "TextFilter1"
        Debug.Print "  " & AF.Filters(1).Criteria1
    Else
        Err.Clear
        lngCriteria1Num = UBound(AF.Filters(1).Criteria1)
        If Err.Number <> 0 Then
            Debug.Print "NoCriteria1"
            Err.Clear
        Else
            Debug.Print "Criteria1"
            For i = LBound(AF.Filters(1).Criteria1) To UBound(AF.Filters(1).Criteria1)
                Debug.Print "  " & AF.Filters(1).Criteria1(i)
            Next i
        End If
    End If
    On Error GoTo 0
    
    'Criteria2
    On Error Resume Next
    strCriteria = AF.Filters(1).Criteria1
    If Err.Number = 0 Then
        Debug.Print "TextFilter2"
        Debug.Print "  " & AF.Filters(1).Criteria2
    Else
        Err.Clear
        lngCriteria2Num = UBound(AF.Filters(1).Criteria2)
        If Err.Number <> 0 Then
            Debug.Print "NoCriteria2"
            Err.Clear
        Else
            Debug.Print "Criteria2"
            For i = LBound(AF.Filters(1).Criteria2) To UBound(AF.Filters(1).Criteria2)
                Debug.Print "  " & AF.Filters(1).Criteria2(i)
            Next i
        End If
    End If
    On Error GoTo 0
    
    'Sort
    If AF.Sort.SortFields.Count = 0 Then
        Debug.Print "NoSort"
    ElseIf AF.Sort.SortFields.Item(1).Order = xlAscending Then
        Debug.Print "SortAscending"
    ElseIf AF.Sort.SortFields.Item(1).Order = xlDescending Then
        Debug.Print "SortDescending"
    End If
    
End Sub

投稿日時: 17/12/12 23:10:58
投稿者: millulillu

baoo さんの引用:
簡単に現在のオートフィルタの状態をイミディエイトウィンドウに書き出す
サンプルを作ってみました。

 
そうですよね!
件数ではなくオートフィルタの状態を保持しておけばよかったんです。
 
今、お風呂で思いついて戻ったら既にBabooさんからのお返事が。
 
どうしたら瞬時にスマートな考えが思いつくのですか。
私は1日考えてこの結果でした…(´-ω-`)
 
大変、勉強になりました。
サンプル動かしてみます!!
babooさん、ありがとうございました(^^