[[20050202131911]] 『オートフィルタに値を渡したい』(九州の関西人) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『オートフィルタに値を渡したい』(九州の関西人)

はじめまして<br>
オートフィルタは、リストから選んで、またはオプションで表示される子画面で入力して<br>
得たい情報を抽出しますが、自分で作った子画面(テキストボックス1個とボタンだけ)<br>
に抽出したい文字列を入力させて、それをオートフィルタに渡し、あとはオートフィルタに<br>
任せて実行させると言うことがしたいのですが、画面(Userform1)の作成と<br>
オートフィルタを出すところはわかったのですが、どうやって画面を表示させ入力された<br>
文字列をオートフィルタに渡せばいいのかがわかりません。<br>
現在以下のように作って停まっています。どうかご教授ください。<br><br>
Sub marklot()
'
' marklot Macro
' マクロ記録日 : 2005/2/2
'
' Keyboard Shortcut: Ctrl+m
'

    Dim str As String
' ここで自分で作った画面を表示して文字を入力してもらいたい
    Selection.AutoFilter
    ActiveWindow.LargeScroll ToRight:=-2
' 入力してもらった文字列を変数strに入れて渡す
    Selection.AutoFilter Field:=1, Criteria1:=str, Operator:=xlAnd
    Selection.AutoFilter
End Sub

使用環境:Excel2000/Win2000SP4


 >自分で作った子画面
 ユーザーフォーム?

 Private Sub CommandButton1_Click()
 Dim str As String
    str = TextBox1.text   
    Range("A:D").AutoFilter Field:=1, Criteria1:=str, Operator:=xlAnd
 End Sub

  (INA)

 衝突しました。
インプットボックスはどうですか?
Option Explicit
Sub marklot()
'
' marklot Macro
' マクロ記録日 : 2005/2/2
'
' Keyboard Shortcut: Ctrl+m
'
    Dim MyStr As String
' ここで自分で作った画面を表示して文字を入力してもらいたい
    MyStr = Application.InputBox("検索文字を入力してください。。。", Type:=2)
    Selection.AutoFilter
    ActiveWindow.LargeScroll ToRight:=-2
' 入力してもらった文字列を変数strに入れて渡す
    Selection.AutoFilter Field:=1, Criteria1:=MyStr, Operator:=xlAnd
    Selection.AutoFilter
End Sub
(SoulMan)

INA様
迅速なご対応感謝致します。早速試したのですがstr = TextBox1.textで
オブジェクトがないと言われました。ちょっと自分でいじったせいかもしれません。
ひとつのメイン関数に入れたんです。まずかったかな?
画面はユーザーフォームです。

SoulMan様
上記で悩んでいたところへ書き込みくださり助かりました。
子画面なんて何でも良いんです。これで充分です。
早速試してみました。
まだ改良の余地はありますが、文字を入力させてオートフィルタに値を渡し
実行することはできるようになりました。
あとは初期処理として(すべて)をはさんで連続操作ができるようにすることと
いま表示結果がおかしいので調整が必要ですが、今、以下のプログラムで
基本動作はしています。ここまで来たらあとはがんばってみます。
本当にありがとうございました。
ここ、レスポンスはやいでんなぁ、大助かりやわぁ
また、わからへんことあったらお願いします、どうもおおきに!!
Option Explicit
Sub Macro8()
'
' Macro8 Macro
' マクロ記録日 : 2005/2/2 '
'

    Dim str As String
    str = Application.InputBox("検索文字を入力してください。。。", Type:=2)
    ActiveCell.Offset(-7, -4).Range("A1:CG1").Select
    Selection.AutoFilter
    ActiveWindow.LargeScroll ToRight:=-2
    Selection.AutoFilter Field:=1, Criteria1:=str, Operator:=xlAnd
End Sub


また来てしまいました。いまいろいろやっているのですが
連続操作を可能にしたいのですが、それにはまずオートフィルタを
(すべて)の状態、つまりオートフィルタがかかっていない状態から
常に動くようにしないといけないため、最初にSelection.AutoFilter
を入れました。しかし連続でやっているとオートフィルタがかかっていない
状態でこれが実行されるタイミングが起こり、動作が不良になります。
そこで、今現在オートフィルタ機能が働いているのかどうか取得する方法は
ないものでしょうか?それがわかれば、条件文でかかっているときだけ
Selection.AutoFilterを実行して解除してやればうまくいきそうです。
もしくは、馬鹿ちょんに先頭で(すべて)を実行させるかですか?
どなたか、ご教授ください、よろしくお願い致します。
Option Explicit
Sub Macro8()
'
' Macro8 Macro
' マクロ記録日 : 2005/2/2
'
'
    Dim str As String

    ' 入力画面の表示
    str = Application.InputBox("MarkLot(下4桁)を入力してください", Type:=2)
    ActiveWindow.LargeScroll ToRight:=-2

    ' オートフィルタ設定
    Range("B4:CH4").Select
    Selection.AutoFilter

    ' オートフィルタで抽出
    Selection.AutoFilter Field:=1, Criteria1:=str, Operator:=xlAnd

    ' すべて表示を指示されたらオートフィルタ解除
    If str = "*" Then Selection.AutoFilter
 End Sub

 AutoFilterMode=False
ですね。。
(SoulMan)


それ一行?知らない者にとっては悩むんですよ。
    ' 初期処理(すべて表示にして解除しておく)
    Range("B4:CH4").Select
    Selection.AutoFilter Field:=1
    Selection.AutoFilter
こんなことしておりました。(爆笑)
早速AutoFilterMode=Falseにしてやってみます。
Soulman様、本当に助かります。ありがとうございました。

すみません!「変数が定義されていない」と怒られてしまいました
オートフィルタがONになっているときだけ解除するコーディング
を教えて頂けないでしょうか?
これ一行では多分行かないんでしょうね?

 ありゃま、すみません。
こんな感じでしょうか??不親切でちょっと反省m(__)m
Option Explicit
Sub てすと()
With Worksheets("Sheet1")
    If .AutoFilterMode Then
        .AutoFilterMode = False
    Else
        .Range("A1").AutoFilter
    End If
End With
End Sub
(SoulMan)

ここまで書いて頂かないとわからない初心者ですので申し訳ないです。
これを基に組み込んでみます。前ポチがいるんですね?
このコーディングはsheet1においてオートフィルタがTrue(働いている)
であればFalse(無効)にする、でなければオートフィルタを動かせる
というものですね。
ありがとうございました。大助かりです。今度こそできるでしょう?
さっきのぶさいくな三行でも結構安定して動いていましたが・・・・

 乗りかっかた船なんで、とりあえず私なら、、ですが、
Option Explicit
Sub Macro8()
' ' Macro8 Macro ' マクロ記録日 : 2005/2/2 ' '
Dim MyStr As Variant
' オートフィルタ設定
With Worksheets("Sheet1")
    .AutoFilterMode = False
    ' 入力画面の表示
    MyStr = Application.InputBox("MarkLot(下4桁)を入力してください", Type:=2)
    If TypeName(MyStr) = "Boolean" Then
        Exit Sub
    Else
        If MyStr = "" Then
            MsgBox "検索値が入力されていません。"
            Exit Sub
        Else
            ActiveWindow.LargeScroll ToRight:=-2
            ' オートフィルタで抽出
            .Range("B4:CH4").AutoFilter Field:=1, Criteria1:=MyStr, Operator:=xlAnd
            ' すべて表示を指示されたらオートフィルタ解除
            If MyStr = "*" Then .AutoFilterMode = False
        End If
    End If
End With
End Sub
署名わすれ、
(SoulMan)


Soulman様、何から何まで書いて頂いて感謝感謝です。
もちろん鵜呑みにせず、理解してまた自分なりにこれを基にアレンジしたいと思います。
とりあえず頂いたCDを試してみます。
本当にありがとうございました。
皆さんにとっては簡単なマクロかもしれませんが、私にとっては勉強の良い機会となり
やっておりうちにのめり込んできました。これも皆さんのおかげです。
心から感謝申し上げます。
また本件か別件でもここを利用させて頂きます。みんな親切やし・・・・


 お礼の意味も込めて、とりあえずできあがったコーディングを公開致します。
 もし同じようなことで困っておられる方の参考になれば幸いです
 
Option Explicit
Sub Macro8()
'
' Macro8 Macro
' マクロ記録日 : 2005/2/3
' 
'
Dim str As String    ' 入力されるLotを格納
Dim msg As String    ' 入力画面の表示メッセージ
'
With Worksheets("Lepton")
    ' 表示メッセージの定義
    msg = "Lepton MarkLot(下4桁)を入力してください。   すべて表示に戻す場合は「キャンセル」ボタンを押して下さい。"
'
    ' 初期処理(もしONならばオートフィルタ解除しカーソルを初期位置にセット)
    If .AutoFilterMode Then .AutoFilterMode = False
    Range("A1").Select
'
    ' 入力画面の表示
    str = Application.InputBox(msg, Type:=2)
'
    ' **入力情報のチェック**
    ' キャンセルされた時はそのまま終了させる
    If str = "False" Then Exit Sub
'
    ' 未入力の場合
    If str = "" Then
       MsgBox "検索する値が入力されていません。もう一度やり直してください。"
       Exit Sub
    End If
'
    ' 半角チェック
    If str <> StrConv(str, vbNarrow) Then
       MsgBox "全角は入力できません。もう一度やり直してください。"
       Exit Sub
    End If
'
    ' 半角4桁ではない入力の場合
    If Len(str) <> 4 Then
       MsgBox "半角4桁で入力してください。もう一度やり直してください。"
       Exit Sub
    End If
 '
    ' 所定位置にオートフィルタ設定
    Range("B4:CH4").Select
    Selection.AutoFilter
'
    ' オートフィルタで抽出、表示
    ActiveWindow.LargeScroll ToRight:=-2
    Selection.AutoFilter Field:=1, Criteria1:=str, Operator:=xlAnd
'
 End With
 End Sub

 再入力させた方が親切でしょうね、でもこれで充分です。
 シートにボタンも作り、ボタン押下で起動できるようにしました。


 InputBoxではなくTextboxを使えば、半角4桁(アルファベット?数字?)の
 入力制限を掛けることができるので、
 判定してエラーメッセージを表示するような手間は掛かりませんよ。

  (INA)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.