[[20150722103002]]　『絞り込み検索』（星羅）　ページの最後に飛ぶ

『絞り込み検索』（星羅）

下記のコードはオートフィルタを使用したものです。
９列目（I列）を"一人"で絞り込みをかけ、H2に入力された日付を検索値にして１１列目（K列）も絞り込みをかけ、出てきたデータのB～M列までを転記します。

オートフィルタを使わずに絞り込み検索をしたいです。ご教示どうぞお願いいたします。

    Const PName = "\\aaa\aaa\aaa\×××\"

    Dim FName As String
    FName = Dir(PName & "△△△(as*" & ".xlsx")

    ThisWorkbook.Worksheets("sheet1").Activate
    sell = Range("H2").Value

    Windows(FName).Activate
    ActiveSheet.Range("$A$5:$AA$30000").AutoFilter Field:=9, Criteria1:="一人"
    ActiveSheet.Range("$A$5:$AA$30000").AutoFilter Field:=11, Criteria1:=sell _
        , Operator:=xlAnd

            Range("B5:M500").Copy
            Workbooks("表.xlsm").Sheets("Sheet1").Range("C4").PasteSpecial
End Sub

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

こんにちは

何故、「オートフィルタを使わずに」なのですか？

フィルタオプションとか、ループ処理とか、数式処理とか
色々有りますが、オートフィルタでも良さそうかと思うのですが。

（ウッシ） 2015/07/22(水) 10:49

ウッシさん

たとえば検索値の日付を”2015/07/22”として絞り込みをかけると”22/07/2015”となってしまい思い通りの結果を得ることができませんでした。
調べてみるとこれは環境やバージョンによってそういう問題が起こることもあるということを知ったので、オートフィルタ以外の方法を知りたいのです。
（星羅） 2015/07/22(水) 11:01

こんにちは

日付の件は良く分からないのですが、

転記先シートのセルH1:I2に抽出条件をセットしても良いとして、
抽出元ブックも開いているとして、

Sub test()

    Dim FName As String
    Dim f     As Workbook
    Dim sell  As String
    Const PName = "\\aaa\aaa\aaa\×××\"

    FName = Dir(PName & "△△△(as*" & ".xlsx")

    Set f = Workbooks(FName)

    With ThisWorkbook.Worksheets("Sheet1")
        '絞込み条件の日付列の項目名をセルH1にセットする。
        .Range("H1").Value = f.Worksheets(1).Range("K5").Value

        '絞込み条件の日付がセルH2にセットされているとする。
        sell = .Range("H2").Value

        '絞込み条件の人数の項目名をセルI1にセットする。
        .Range("I1").Value = f.Worksheets(1).Range("I5").Value

        '絞込み条件の人数をセルI2にセットする。
        .Range("I2").Value = "一人"

        '抽出項目名をセルI2にセットする。
        f.Worksheets(1).Range("B5:M5").Copy .Range("C4")

        f.Worksheets(1).Range("A5").CurrentRegion. _
            AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("H1:I2"), _
            CopyToRange:=.Range("C4:N4"), Unique:=False
    End With
End Sub

フィルタオプションですけど、日付はどうなりますか？

（ウッシ） 2015/07/22(水) 11:45

 横から失礼します

 オートフィルター、フィルターオプション、Find検索、あるいはMATCH等の検索それぞれ日付の検索はやっかいなものの１つですね。

 フィルターオプションの場合は、検索キーの日付と、検索先の日付群の表示書式を同じものにすることで検索できるかと思います。
 オートフィルターの場合は、最近のバージョンなら、↑と同じ状態にしてやれば Criteria1 指定でいけるはずです。
 また、バージョンを問わず、検索値をいわゆるシリアル値（Value2) にして　xlAnd で不等号ではさみこんでやれば
 安定して抽出可能です。

[[20150602132430]]　『オートフィルタで日付』（アイ）

 ↑の、kanabunさんのレスを参照願います。

（β） 2015/07/22(水) 13:01

ウッシさん
RangeクラスのAdvancedFilterメソッドが失敗しました。とエラーが出てしまいました。
（星羅） 2015/07/22(水) 13:29

βさん
まさにこの質問と同じようなことをやろうとしているのですが、kanabunさんの最後に書かれた不等号のものを使用すると何も表示されなくなってしまいます（？）。
F8で１行ずつ動かしながら、必要なデータの入ったブックの方のK列（日付）→日付フィルター→指定の範囲内を見てみるとテキストボックスには何も入っていませんでした。
（星羅） 2015/07/22(水) 13:34

こんにちは

抽出元のK列の日付の列にはどのようなデータが入っていますか？
日付の形式は？

また、抽出先の抽出条件のH2の日付はどのように入力されていますか？

コードの後半を下記に差し替えて、実行がストップされた時点で選択されたセルが
絞込み条件、抽出先項目名、抽出先データ範囲になっているか確認して下さい。

        '絞込み条件の人数をセルI2にセットする。
        .Range("I2").Value = "一人"

        Application.Goto .Range("H1:I2")
        Stop

        '抽出項目名をセルI2にセットする。
        f.Worksheets(1).Range("B5:M5").Copy .Range("C4")
        Application.Goto .Range("C4:N5")
        Stop
        Application.Goto f.Worksheets(1).Range("A5").CurrentRegion
        Stop
        f.Worksheets(1).Range("A5").CurrentRegion. _
            AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("H1:I2"), _
            CopyToRange:=.Range("C4:N4"), Unique:=False
    End With
End Sub

（ウッシ） 2015/07/22(水) 13:50

ウッシさん
K列には同じ形式の日付しか入っていません（2014/07/01、2014/04/02など）
セルの書式設定では"*2001/03/14"となっております。

エラーが出るのは f.Worksheets(1).Range("A5").CurrentRegion. _ ～　　こちらの部分です。エラーは先ほどと同じものです。
（星羅） 2015/07/22(水) 14:00

 >>F8で１行ずつ動かしながら、必要なデータの入ったブックの方のK列（日付）→日付フィルター→指定の範囲内を見てみるとテキストボックスには何も入っていませんでした。

 この意味がよくわかりません。
 ステップ実行ではなく、マクロから離れて操作でオートフィルターを試してみたら　ということならわからないでもないですが？

 テキストボックス　って　何ですか？　そこに何も入っていないとは、何のことを言っておられるのでしょうか？

（β） 2015/07/22(水) 14:02

 追加で。
 絞り込みキーとして与える sell は sell = .Range("H2").Value ではなく　sell = .Range("H2").Value2 ですが
 そうしても抽出されなかったということですか？

（β） 2015/07/22(水) 14:04

βさん
テキストボックスとは言わないんですね、、申し訳ありません。オートフィルターオプションにある抽出条件の指定という欄のことです。
ええと、つまり検索値はあるのに空白のセルとして絞り込みがかけられていて、結果として表.xlsmには入っていたすべてのデータを抽出してしまいました。

＞sell = .Range("H2").Value2
こちらでも試してみましたが結果は同じでした。
（星羅） 2015/07/22(水) 14:09

 >>こちらでも試してみましたが結果は同じでした。

 sell のデータ型は、シリアル値を格納するわけですから、Double型ですけど、それは大丈夫ですか？

 新規ブックに、以下をコピペ。
 まず、DataGenを実行してください。簡単なテストデータを作成します。
 (21:50 TestGen コードのシート修飾がぬけていたので訂正）

 で、このリストに対して、Test1を実行してみてください。これがkanabunさん提示の方法です。
 参考までに Test2。最近のバージョンであれば、これでもＯＫになるはずです。

 両者の 変数 D8 の　データ型に注目してくださいね。

 Sub DataGen()
    With Sheets("Sheet1")
        .AutoFilterMode = False
        .Cells.Clear
        .Range("A1:B1").Value = Array("項目1", "項目2", "項目3")
        .Range("A2").Value = Date
        .Range("A2:A20").DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlDay, Step:=1, Trend:=False
        .Range("D8").Value = Date + 5
        .Range("B2:B20").Formula = "=""Data""&Row()"
        .Range("B2:B20").Value = .Range("B2:B20").Value
        .Range("A1").AutoFilter
    End With

 End Sub

 Sub Test1()
    Dim D8 As Double
    D8 = Range("D8").Value2
    ActiveSheet.AutoFilter.Range.AutoFilter Field:=1, Criteria1:=">=" & D8, Operator:=xlAnd, Criteria2:="<=" & D8
 End Sub

 Sub Test2()
    Dim D8 As String
    D8 = Format(Range("D8").Value, Range("A2").NumberFormatLocal)
    ActiveSheet.AutoFilter.Range.AutoFilter Field:=1, Criteria1:=D8
 End Sub

（β） 2015/07/22(水) 17:43

コメント返信：

[ 一覧(最新更新順) ]

[[20150722103002]] 『絞り込み検索』（星羅） ページの最後に飛ぶ

[[20150722103002]]　『絞り込み検索』（星羅）　ページの最後に飛ぶ