[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数条件での絞込み』(AS)
お世話になります。
以前にも同じような質問をしていたのですが、再度行き詰ってしまったので質問させて頂きます。
以下のようなマクロを組んだのですが、現状絞込みの条件1が20個(E11〜X11),条件2が400(Y11〜PH11)個有る状況です。
一応、求めるものはできたのですが、この状況だと、if〜end ifまでを条件の組み合わせ数である8000通り組まないといけない状況で、修正等が入ると大変なことになってしまっています。
どうにかして、絞込みの部分のマクロを纏めたいのですが、どのようにしたらよいでしょうか。
当方、これが初めてのVBAと言う事もあり、周りに聞けるような人もいないため、完全に行き詰ってしまっています。
どなたか、ご教授頂けるようお願いいたします。
−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
Sub 検索()
Dim 商品名, 法令
商品名 = Sheets("検索シート").Range("$B$6") 法令 = Sheets("検索シート").Range("$B$8")
'画面更新停止 Application.ScreenUpdating = False
With Sheets("入力シート")
'オートフィルター解除 .AutoFilterMode = False
'オートフィルターセット .Range("$A$11:$PH$11").AutoFilter
End With
'法令1及びパッド1で検索 If Sheets("入力シート").Range("$E$11") = 法令 And Sheets("入力シート").Range("$Y$11") = 商品名 Then
With Sheets("入力シート").Range("$A$11:$LL$11") ’条件1 .AutoFilter Field:=5, Criteria1:="<>" ’条件2 .AutoFilter Field:=25, Criteria1:="<>"
End With
'検索結果をコピー With Sheets("入力シート") .Range("$A$11:$D$1000").Copy Worksheets("検索シート").Range("$A$11") .Range("$PI$11:$PM$1000").Copy Worksheets("検索シート").Range("$E$11")
End With
End If
↓
※以下絞込み条件1が20個、条件2が400個で
if〜end ifまで条件を変えて同じものを繰り返し。
'入力シートのオートフィルタを解除 Sheets("入力シート").Range("$A$11:$PH$11").AutoFilter
'画面更新再開 Application.ScreenUpdating = True
End Sub
< 使用 Excel:Excel2010、使用 OS:Windows7 >
そうではなくて、対象とする全ての列にフィルタをかけてしまい、残った行をコピー、で良いように思いますが、いかがでしょう?
この考え方で良いならば、例えば「法令」の列全てのCountAを計算する式をPJ列等に。「商品名」の列全てのCountAをPK列に書き、
この2列が0でないものを残すだけのように思えます。これなら手作業でもすぐできます。
(???) 2016/04/25(月) 11:23
CountAで質問ですが、調べてみたのですが当てはまる箇所のセルの個数しか出ないのではないでしょうか?
勉強不足で大変申し訳ありません。
(AS) 2016/04/25(月) 11:47
どういうデータならどういう結果にしたいのか、数件の例があれば、誤解なく考えられるのですが。
(???) 2016/04/25(月) 12:57
例で言うと、Aという案件で、法令1と商品1が掛かっている部分だけ検索シートにコピーとしたいのです。
表で書くと
案件 法令1 法令2・・・法令20 商品1 商品2・・・商品400
1 A 1 1
2 B 1 1
3 C 1 1 1
※「1」は仮で書いています。
このようになっており、検索シートにデータの入力規則でドロップダウンリストを作って選択できるようにしています。
ドロップダウンリストで法令及び商品を選択し、検索ボタンを押下すると該当条件で絞込み検索をしてA列〜D列及び
PI列〜PM列を検索シートにコピーすると言う形にしたかったのです。
(AS) 2016/04/25(月) 13:08
つまり、B6セルは法令を選択できるようになっており、そこに表示される文字列と同じ文字列がE11:X11のどこかにある。
同様に、B8セルは商品名であり、同じ文字列がY11:PH11のどこかにある、と。
選ばれたものと同じ2列で空白除外すると、欲しいデータだけ残る。これをコピーということですかね?
ならば、選ばれた2列がどこかを探し、そこだけフィルターで良さそう。
Sub test() Dim wkN As Worksheet Dim wkK As Worksheet Dim i As Long
Set wkN = Sheets("入力シート") Set wkK = Sheets("検索シート")
With wkN .AutoFilterMode = False .Range("$A$11:$PH$11").AutoFilter
For i = 1 To 20 If .Cells(11, i + 4).Value = .Range("B6") Then .Cells.AutoFilter Field:=i + 4, Criteria1:="<>" Exit For End If Next i For i = 1 To 400 If .Cells(11, i + 24).Value = .Range("B8") Then .Cells.AutoFilter Field:=i + 24, Criteria1:="<>" Exit For End If Next i
.Range("$A$11:$D$1000").Copy wkK.Range("$A$11") .Range("$PI$11:$PM$1000").Copy wkK.Range("$E$11") .AutoFilterMode = False End With End Sub (???) 2016/04/25(月) 14:09
内容としては、やりたかった事ずばりです!
で、試してみたのですが、検索条件(検索シート.B6及びB8)にリンクされず、
for i=1 to 20及び1 to 400 の部分で順次処理されないようです。
現状、検索条件に何も入れなくてもE11(法令1)とY11(商品1)だけでフィルタされています。
For i = 1 To 20
If .Cells(i + 4, 11).Value = wkK.Range("B6") Then .Cells.AutoFilter Field:=i + 4, Criteria1:="<>" Exit For
End If
Next i For i = 1 To 400 If .Cells(i + 24, 11).Value = wkK.Range("B8") Then .Cells.AutoFilter Field:=i + 24, Criteria1:="<>" Exit For
End If
Next i
分かる範囲では弄ってみたのですが、For i = 1 to 20 の部分は順次1〜20を見て行ってwkKのB6及びB8の文字列と同じものが引っかかったら、フィルターを掛けるという意味で良かったですよね?
何もかも聞いてしまっているようで大変申し訳ありません。。。
(AS) 2016/04/25(月) 15:16
検索条件を入れると、オートフィルターはセットされますが、"<>"が効かないようです。
検索条件を入れないと、先に記載したようになるようです。。。
何がどうやったらそうなるのか、?????の状態です・・・
(AS) 2016/04/25(月) 15:36
>.Cells(i + 4, 11).Value >.Cells(i + 24, 11).Value
ところで、前回質問のβさんの回答は試さなかったのでしょうか。 [[20160418152824]] 『オートフィルタ検索条件』(AS)
(マナ) 2016/04/25(月) 22:34
マナ様
ご指摘ありがとうございます。
色々と試しているうちにゴチャゴチャになってしまっていたようです。
β様の回答の件については、私の勉強不足も有ってうまくいかなかった次第です・・・
ご回答頂いた皆様、本当にありがとうございました!
(AS) 2016/04/26(火) 09:30
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.