Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9070 / 13644 ツリー ←次へ | 前へ→

【29490】オートフィルタの条件抽出 yhar 05/10/6(木) 12:11 質問[未読]
【29495】Re:オートフィルタの条件抽出 Jaka 05/10/6(木) 13:28 質問[未読]
【29508】Re:オートフィルタの条件抽出 yhar 05/10/6(木) 18:28 お礼[未読]
【29504】Re:オートフィルタの条件抽出 awu 05/10/6(木) 17:21 回答[未読]
【29506】Re:オートフィルタの条件抽出 yhar 05/10/6(木) 18:08 お礼[未読]

【29490】オートフィルタの条件抽出
質問  yhar  - 05/10/6(木) 12:11 -

引用なし
パスワード
   参考書を見ても過去ログを見ても中々それらしい答えが見つからないのでよろしくお願いします。
ある管理台帳風のワークシート上でA6:Q6の範囲にオートフィルタを適用します。このときにフィルタをかけた検索条件を
1.一括して同じシートのセルB5に表示する
※イメージとしては"検索条件=「りんご」、「100円以上」"といった感じ。
または
2.同じシートのA5:Q6に各列ごとに表示する
のいずれかを行いたいと思っています。表示するタイミングとしては矢印をドロップダウンして検索条件を指定した直後に表示を変更するというが望みです。

何卒皆様のお知恵を拝借したくよろしくお願いします。

【29495】Re:オートフィルタの条件抽出
質問  Jaka  - 05/10/6(木) 13:28 -

引用なし
パスワード
   ワークシート
Private Sub Worksheet_Calculate()のイベントを使って、

抽出したセル(表示されているセル).Cells(1).value か
抽出したセル(表示されているセル).Cells(1,列数).value で、
取るしかないと思います。

注)Cells(1,列数)の列数は、オートフィルタ範囲の1番左を基準とする。

【29504】Re:オートフィルタの条件抽出
回答  awu  - 05/10/6(木) 17:21 -

引用なし
パスワード
   こんな感じで如何でしょうか。

データの内容が分りませんので、提示のコードは、以下の条件になっております。

・Calculateイベントを使用していますので、何処か空いているセル(例えばA1)に
 =SUBTOTAL(3,A7:Q50) 等の計算式を設定します。
 (フィルタのOn/Offで再計算になるような計算式が既にある場合は、不要です。)

・日付等にフイルタを掛ける場合の条件は、内部ではシリアル値で処理されるため
 表示される条件もそのままシリアル値で表示されます。
 (ちょっと工夫すれば、書式と同じ表示にすることは可能です。)

・フイルタ位置は、自動で検出していますが、フィルタ解除時のレスポンス向上の
 ため表示された条件式を消去するためのコードが、3行目にありますので、
 フィルタ位置変更の時は、ここだけ変更してください。

使用しているシートのシート名タブを右クリックして「コードの表示」を指定し、
開いたコードウィンドウに下記コードをコピーして貼り付けます。

これでたぶん ご希望通りの動作になると思います。


Private Sub Worksheet_Calculate()
If Not AutoFilterMode Then
  Range("A5:Q5").ClearContents
  Exit Sub
End If
Dim Rng As Range
Dim FRng As Range
Dim N As Integer
Dim Cri As String
Dim FltAry()
Application.EnableEvents = False
With ActiveSheet.AutoFilter
  Set FRng = .Range.Resize(1)
  If FRng.Row = 1 Then
    MsgBox "条件を表示出来ません。フィルタ位置を下げてください。"
    Set FRng = Nothing: Exit Sub
  End If
  With .Filters
    ReDim FltAry(1 To .Count, 1 To 3)
    For N = 1 To .Count
      With .Item(N)
        If .On Then
          FltAry(N, 1) = .Criteria1
          If .Operator Then
            If .Operator = 1 Then
              FltAry(N, 2) = " And "
            ElseIf .Operator = 2 Then
              FltAry(N, 2) = " Or "
            End If
            If FltAry(N, 2) <> "" Then
              FltAry(N, 3) = .Criteria2
            End If
          End If
        End If
      End With
    Next
  End With
End With
FRng.Offset(-1).NumberFormatLocal = "@"
For Each Rng In FRng.Offset(-1)
  Cri = FltAry(Rng.Column, 1) & _
      FltAry(Rng.Column, 2) & _
      FltAry(Rng.Column, 3)
  If Trim(Cri) = "" Then
    Rng.ClearContents
  Else
    Rng.Value = Cri
  End If
Next Rng
Application.EnableEvents = True
Set FRng = Nothing
End Sub
 

【29506】Re:オートフィルタの条件抽出
お礼  yhar  - 05/10/6(木) 18:08 -

引用なし
パスワード
   awu さま/yhar

完璧ですっ!あれほど抽象的な質問に対してこれほどのご回答を当日にいただけるとは!!
ありがとう御座いました。コードの内容はこれから熟読して理解に努めます。
いつの日か私自身もどなたかの役に立てるよう精進しますので今後ともよろしくお願いします!!!

▼awu さん:
>こんな感じで如何でしょうか。
>
>データの内容が分りませんので、提示のコードは、以下の条件になっております。
>
>・Calculateイベントを使用していますので、何処か空いているセル(例えばA1)に
> =SUBTOTAL(3,A7:Q50) 等の計算式を設定します。
> (フィルタのOn/Offで再計算になるような計算式が既にある場合は、不要です。)
>
>・日付等にフイルタを掛ける場合の条件は、内部ではシリアル値で処理されるため
> 表示される条件もそのままシリアル値で表示されます。
> (ちょっと工夫すれば、書式と同じ表示にすることは可能です。)
>
>・フイルタ位置は、自動で検出していますが、フィルタ解除時のレスポンス向上の
> ため表示された条件式を消去するためのコードが、3行目にありますので、
> フィルタ位置変更の時は、ここだけ変更してください。
>
>使用しているシートのシート名タブを右クリックして「コードの表示」を指定し、
>開いたコードウィンドウに下記コードをコピーして貼り付けます。
>
>これでたぶん ご希望通りの動作になると思います。

【29508】Re:オートフィルタの条件抽出
お礼  yhar  - 05/10/6(木) 18:28 -

引用なし
パスワード
   Jakaさま/yhar

awuさんのコードに感動してお礼を忘れていました。内容からすると
同じようなことをご教授下さったものと判断します。
ありがとうございました。

▼Jaka さん:
>ワークシート
>Private Sub Worksheet_Calculate()のイベントを使って、
>
>抽出したセル(表示されているセル).Cells(1).value か
>抽出したセル(表示されているセル).Cells(1,列数).value で、
>取るしかないと思います。
>
>注)Cells(1,列数)の列数は、オートフィルタ範囲の1番左を基準とする。

9070 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free