[[20040723161153]]　『オートフィルターで選択した項目名を別のセルに表』（すぎ）　ページの最後に飛ぶ

『オートフィルターで選択した項目名を別のセルに表示』（すぎ）

[オートフィルターで選択した項目名を別のセルに表示させたい]

また、お世話になります。

以下のような表にオートフィルターをかけて、顧客名を選択して顧客毎に売上高を

見ていますが、選択された顧客名を別のセル（D1)に表示する方法があれば教えて下さい。

単に=INDIRECT("A1")では”顧客名”としか出ないようですが・・・

    A      B       C       D

1 顧客名　売上高

2　AAA　　150

3　BBB　　100

4　CCC　 200

自己レスです。

以前、逆のケース（別シートから指定してオートフィルターのかかっている項目を自動表示

させる方法）を夏目雅子似さんからご教示いただいたことがあり、それを応用しようとしました

がうまく行かずに質問するものです。よろしくお願いします。（すぎ）

 すぎさん、こんばんは^^
[[20040701100746]]『オートフィルター列内の任意項目の自動検出』（すぎ） 
 ↑こちらですね。でも、私、もう完全に忘れてしまってて、ごめんなさいね。m(__)m
 こちらの反対ということであれば
 シート2に↓を貼り付けますか
 Private Sub Worksheet_Activate()
 　With Sheets("Sheet1").AutoFilter
     If .Filters(1).On = True Then
         Range("D1").Value = Mid(.Filters(1).Criteria1, 2)
     End If
 　End With
 End Sub
 あるいは、
 A1からB10にデータ
 E1からF2に抽出条件
 例えば
　E1　　　F1
 顧客名　売上高
  AAA
 と入力して
 D1に
 =DGET(A1:B10,1,E1:F2)
 とする場合もありますし、お話から察しますと
 すぎさんの場合はフィルタのオプション設定はいかがでしょうか？
（既にご存知でありましたら、ごめんなさいです。）
 データ→フィルタ→フィルタのオプション設定とすすみますと
 リスト範囲
 抽出条件
 抽出先
 と選択出来ます。
 また、この操作をマクロに記録しますと簡単にコードを入手できますので
 いかがでしょうか？
（夏目雅子似）

夏目雅子似さん　お久しぶりです。その節は大変お世話になりました。
今回もまたお世話になります。

返信が遅くなってしましましたが、せっかくのご提案がいづれも旨く行かずに今まで
悩んでいました。
先のものとは単純には反対の動作ですが、今回は同一シート内で行いたいことです。

ご提示いただいたプログラムで最初のものは、シート１のオートフィルターが設定された
リストで選択された顧客名がシート２のD1に返されるということでしょうか？
（実際には何も返されないのですが・・・）

次のDGET・・・については初めての関数（？）で意味がよく理解できないまま実行して
みましたが、やはり何にも動作していないようで・・・

最後のフィルタのオプション設定についても初めて見た内容で、何ができるものなのかが
判っていません。

なお、過去ログの[[20040423130848]][『支店名を入力すると「支店名」の下の支店を表示』（ＳＨＡＬＡＬＡ）
と同じ趣旨のものですが、これも誰からも回答がでていなようなので、私のやりたいことの
説明がうまく伝わっていなかったらこちらの回答でもOKですので、よろしくお願いいたします。

一部修正（すぎ）

 こんばんは。
 ご質問の主旨は、なんとなく分かったのですが、
 フィルターの操作と同時となると、私の力では、無理の様です汗
 過去ログの[[20040423130848]]を例にしてみましたので
 Alt+F11でVBEを起動、標準モジュールに貼り付けてください。
 シートのどこかにコマンドを作ってこのマクロを登録する事に
 なるかと思いますが、どうでしょう？
 なお、A3からデータがあり
 A1　B1　に表示する様にしています。
（夏目雅子似）
 Sub オートフィルターの抽出結果()
 Dim MyR As Range 'データ範囲をRangeで宣言
 Dim MyData As Variant
 Dim MyDataRng As Range  '抽出後の範囲
    With ActiveSheet
        If .AutoFilterMode = False Then
            .Range("A1:B1").ClearContents
            Exit Sub
        End If

        Set MyR = .Range("A3").CurrentRegion  'データ範囲の取得

        With MyR
            Set MyDataRng = .Offset(1) _
                .SpecialCells(xlCellTypeVisible)  '抽出した範囲の可視セル範囲の最上行を取得
        End With

        .Range("A1").Value = .Cells(MyDataRng.Row, 1).Value
        .Range("B1").Value = .Cells(MyDataRng.Row, 2).Value
    End With
    Set MyR = Nothing
    Set MyDataRng = Nothing
 End Sub

 あのぅ、、誠にもって余計なお世話かもしれませんが、
 普通は（失礼）、検索条件があって、それに対応するデータが表示される。
 と言うのが一般的かと思うのですが、、つまり、すぎさんの反対といいますかぁ、汗
 何分にも気分を悪くなさらなでくださいね。というわけでフィルターオプションについて
 少し調べてみましたので参考にしてください。
（夏目雅子似）
[[20040709142704]] 『別シートに必要項目だけ抜き取る』(エビ) 
[[20040611204057]] 『Excel VBAの AdvancedFilterについて』(jun)
[[20040528091932]] 『一覧表から抽出するやりかた』(ゆずな) 
http://homepage1.nifty.com/kenzo30/ex_kisotoku/ex_ks_tokubetu9.htm

 それから
 DGET関数についてはExcelのヘルプで一度調べてみてください。
 使い方は↓のようになっています。
 =DGET(Database, フィールド, Criteria)

 夏目雅子似さん こんばんわ。
 早朝からのご回答をいただいていながら、返信が遅れて申し訳ありませんでした。
 （一日中外出で先ほど帰宅して今、動作確認をしたところです。）
 期待の動作がほとんどできていることに感動しました。ありがとうございます。
 ＊いつもながらの木目細かな説明付で（それでも私にはまだまだ追いつけませんが）
 本当に勉強になります。
 ところで、最終希望はオートフィルターでフィルタリングしたと同時に（都度マクロの
 実行指示をしなくても）A1に表示されるようにしたいのですが、これは不可能なので
 しょうか？

 なお、ご指摘いただいた
 >普通は（失礼）、検索条件があって、それに対応するデータが表示される。
 >と言うのが一般的かと思うのですが、・・・
 ですが、今回は（AAA会社殿）のようなに、選択したAAAの部分をリストの表題として
 利用したかったのでこのようなリクエストになったものです。

 それと、DGET関数のことですが、ヘルプを見ましたが正直、何を説明してるのか
 よく理解できませんでした。
 もう少し、初心者レべルで説明いただければ助かりますので、お手すきのときにでも
 教えていただければ幸いです。（すぎ）

 すぎさん、おはようございます。
 先ずは、DGET関数を利用した場合です。
 今回の場合は、こちらの方がいいかもしれません。
　A1　　B1　　C1　　D1　　E1　　F1　　G1　　H1   I1
 1                            F1=DGET(A3:D8,1,F3:F4)
 2　　　　　　　　　　　　　　　 　　　G1=VLOOKUP($F$1,$A$4:$D$8,COLUMN(B1),FALSE)→コピー
 3項目1 項目2 項目3 項目4       項目1
 4 aaa   125   222   555　　　　zzzなどと入力する。
 5 sss   124   333   666　　　（ここにデータ→入力規則→リストで
 6 qqq   145   444   777　　　　範囲にA列を指定すれば、結果的に
 7 zzz   174   555   888　　　　オートフィルターと同じ様な効果が
 8 ccc   156   666   999　　　　得られると思います。）

 次は、マクロを使った場合です。
 シートの見出しを右くりっく
 コードを表示させてそこに貼り付けます。
 注意書きをコードの中に書いていますので、参考にしてください。
 では、(^^)V
（夏目雅子似）
 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Dim MyR As Range 'データ範囲をRangeで宣言
 Dim MyDataRng As Range  '抽出後の範囲
 'ターゲットがA2に無いとイベントを中止します。
 'この制限を解除するとセルを移動させただけでイベントが発生し
 'PCに負担がかかりますので、あまり、お勧めは出来ません。
 'この$A$2を作業上の都合のよいセルに変更して使用してください。
 'フィルターをかけた後にA2を選択するとイベントが発生して
 '抽出された最上行のデータがA1からD1に表示されます。
 If Target.Address <> "$A$2" Then Exit Sub
    Application.EnableEvents = False
        With Me
            If .AutoFilterMode = False Then
                .Range("A1:D1").ClearContents
                Application.EnableEvents = True
                Exit Sub
            End If

            Set MyR = Range("A3").CurrentRegion  'データ範囲の取得

            With MyR
                Set MyDataRng = .Offset(1) _
                    .SpecialCells(xlCellTypeVisible)  '抽出した範囲の可視セル範囲の最上行を取得
            End With
            'MsgBox MyDataRng.Row
            Cells(1, 1).Resize(, 4).Value = Cells(MyDataRng.Row, 1).Resize(, 4).Value
        End With
    Set MyR = Nothing
    Set MyDataRng = Nothing
    Application.EnableEvents = True
 End Sub

 夏目雅子似さん、おはようござます。
 （日曜日！休日？にもかかわらず）早朝からの、返信ありがとうございます。

 早速、動作確認させていただきました。
 いづれも、(結果的には）希望の形が確認できました。特にマクロ利用の場合は都度マクロの
 実行ボタンを押さなくても実行できていることに感動です。
 マクロでの今回のステップは、
 ステップ１；A2でターゲット指定
 ステップ２；フィルターで当該ターゲットを選択
 ステップ３；A2セルをクリック
 をすることで、抽出された最上行がA1に返される。
 になっていると思いますが、最終希望は（先信でも述べましたが）ここで言う
 「ステップ２のみで抽出された最上行を返す」ことです。
 わがままな希望ですがなんとかならないでしょうか？

 なお、DGET関数につきましてもお蔭様で理解が深まりました。ありがとうございます。
 ただ、こちらも今回の（わがままな）最終希望としてはステップの軽減が必要です。
 PS,今日も暑い日になりそうですね。お体ご自愛ください。_(._.)_。（すぎ）

 はぁ～～～い！！おまたっせ～～！！
 フィルターセレクトすぐとは行きませんが、セレクトした後に二回だけ
 セルをちょこちょこっぉ～～と、、動かしてちょんまげぇ～～！！。
 って私には無いけど、腕も無い(>_<)
 これで、許しておくなましぃぃm(__)m
（夏目雅子似） 
 Option Explicit’変数を宣言する事を誓います。あぁ～めん！
 Public MyDCri As String'したがいましたMyDCriは文字列でございます。
 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Dim MyCri As String'宣言すると誓いましたので、MyCriも文字でございます。
 Dim MyR As Range 'データ範囲をRangeで宣言
 Dim MyDataRng As Range  '抽出後の範囲
 Application.EnableEvents = False'自分で自分の変化に対応しない様にイベントを無効にします。
 If MyCri <> MyDCri Then'もしも、MyCriとMyDCriが同じではなかったら、
        With Me'私の、
            If .AutoFilterMode = False Then'オートフィルターモードがかかってなかったら、
                .Range("A1:D1").ClearContents'A1からD1をクリアにします。
                Application.EnableEvents = True'イベントを有効にします。
                Exit Sub'この、コードから出ます。
            End If'もしも、の終わりです。

            Set MyR = Range("A3").CurrentRegion  'データ範囲の取得

            With MyR'.の前にMyRをつけます。
                Set MyDataRng = .Offset(1) _'MyRを一つ下にずらします。
                    .SpecialCells(xlCellTypeVisible)  '抽出した範囲の可視セル範囲の最上行を取得
            End With'.の前にMyRをつけるのやめます。

            Cells(1, 1).Resize(, 4).Value = Cells(MyDataRng.Row, 1).Resize(, 4).Value'A1のから右へ4つ範囲を広げた範囲と可視セルの範囲の最上行の一列目から右に4つ範囲を広げた範囲の内容はおなじです。
        End With'.の前に私の、をつけるのをやめます。
    Set MyR = Nothing’セットしたので開放します。
    Set MyDataRng = Nothing'セットしたので開放します。

    With Me.AutoFilter'私の、
        If .Filters(1).On = True Then'オートフィルターのフィールド1がオンだったら
          MyCri = Mid(.Filters(1).Criteria1, 2)'MyCriはそれです。
        End If'もしものおわりで。
    End With'私の、をやめます。
 Else'もしも、MyCriとMyDCriが同じだったら
    With Me.AutoFilter'私の、
        If .Filters(1).On = True Then'オートフィルターのフィールド1がオンだったら
          MyDCri = Mid(.Filters(1).Criteria1, 2)'MyDCriはそれです。
        End If'もしも、のおわりです。
    End With'私のを、つけるのをやめます、
 End If'もしも、MyCriとMyDCriが違っていたらの、もしもの終わりです。
 Application.EnableEvents = True
 End Sub'この、コードのおわりです。
 ちょっと、変更しましたm(__)m
（夏目雅子似）

 夏目雅子似さん
 しつこい追求（自分でもそう思ってます）にも拘らず見放さずにここまで完成させていただき
 本当にありがとうございます。フィルターセレクト後、1回だけのアクティブセル以外のセルク
　リックで希望値が返っていますね。これで充分です。数十社のリスト作成なので、ここでの
　クリック回数や入力動作が１回でも軽減できることは大助かりです。深謝_(._.)_。

 後学のために、今回のマクロの詳細説明が省略されている部分もご教示いただければ幸いで
 す。お手すきの時で結構ですのでよろしくお願いします。
 本当に助かりました。またの機会にも（これに懲りずに）よろしくお願いいたします。
 （すぎ）

 私なりにコメントをつけてみましたぁ、、でも、多分無茶苦茶でっすぅ^^;
 だから、あまり参考になさらないでくださいませ。それから、
 私の事は、全然お気になさらないで下さい。私は、ほとんど自分自身のスキルの為に
 やっている様なものですから、、私も大変勉強になりました。
 ありがとうございました。本当は、もっといい方法がありそうなのですが、今の私の力では
 ここまでです。では、今後とも何卒、よろしくお願い致します。m(__)m
（夏目雅子似）

コメント返信：

[ 一覧(最新更新順) ]

[[20040723161153]] 『オートフィルターで選択した項目名を別のセルに表』（すぎ） ページの最後に飛ぶ

[[20040723161153]]　『オートフィルターで選択した項目名を別のセルに表』（すぎ）　ページの最後に飛ぶ