エクセルの抽出技

質問

エクセルで2000行×30列の表を操作しています。
フィルタオプションを使い100行の条件式で抽出し各結果をカウントしていますが条件式もデータ数も膨大の為問題点があります。

ファイルサイズが重くなる
条件式の変更や追加が大変。

VBAのプロシージャを使うとフィルタオプションは使用しないで済む方法はありますか？
VBAは初級です。
お知恵を貸してくださいませんか。

回答No.14

TAKA_R · ベストアンサー

とてもスマートでコンピュータにもやさしい１文ですね。
私も真似せねば！！

もう出来上がっているかもしれませんが、あとは条件文の行と列の取得となりましたね。
どちらの文もfor-nextの中に入れてエクセルに計算させるのが楽だと思います。
列はおなじみのendで、行は面倒だけどdo-loopでカウントしたらどうでしょう？？
あまりスマートな文でなくて、申し訳ないけれど、、、、

回答No.13

TAKA_R

コメント通りであってます。
カウント数が1多いのは指摘どおりフィールドを含んでいるせいです。
すみませんが、配列に入れるときに引いてください。後で引いてもいいけれど。

＞※また、条件に合ったレコード件数を上から順に拾った結果が抽出されているみたいです。　 カウントが目的だから問題ないでしょうか。

正確に言うと、フィルタされた結果をws2に貼り付けて、最終行を探しています。
レコードの件数を知るという点では問題ないと思っています。

条件列の取得は比較的簡単だと思いますが、連続行での条件行の取得は苦戦すると思います。
あと、条件文に一致する行が無い時、空白行を数えてしまうのでそれを０にするif文を、足しておいてください。

お礼

おかげさまで空白行を数えないように、格納する行数のカウントを下記のように変更しました。
フィールド行しかない時は、０になりました。

あとは、１００行×３パターンで実践してみます。
ありがとうございました。
またお時間のある時にご教授いただけると助かります。

ct(k) = ws2.Range("a1").Range("a65536").End(xlUp).Row - 1

補足

いつもいつもありがとうございます。

ct(k) = ws2.Range("a1").End(xlDown).Row
の文にIF分を組み込めばいいのでしょうか。

回答No.12

TAKA_R

正直言ってセレクションをいじるのは面倒です・・・。
もし条件を書きはじめるセルが決まっていて、フィールド名と条件値のセルの数合計がいつも２なら、
それだけで１００のfor文を書いたほうが早いと思います。
ちなみにフィールド名の数はいつも１個なのでしょうか。
空白のワークシート"2"を作って置きました。（このほうが楽なので）
計算を必要としない普段は、削除しておいて問題ないです。
計算用と配列のカウントした数を書き出させるようにしてます。
条件の書き始めのセルをa1,条件フィールド１個、値１個と仮定して書くと。

Sub daburi()
Dim k
Dim ws2, ws As Worksheet
Dim ct(100)
Set ws2 = Worksheets("2")
Set ws = Worksheets("sheet1")
For k = 1 To 100
ws2.Cells.Clear
ws.Range("a201:ad10000").AdvancedFilter _
Action:=2, _
CriteriaRange:=Range("a" & 2 * k - 1, "a" & 2 * k), _
CopyToRange:=ws2.Range("A1")
ct(k) = ws2.Range("a1").End(xlDown).Row
Next
ws2.Cells.Clear
For k = 1 To 100
ws2.Cells(k, 1) = ct(k)
Next
End Sub

8秒ほどかかりますね。
データを列方向に少ししか入れていないので、入っていたらもっとかかるのではないかと思います。
もっと速くないと・・・というのであれば、フィルタオプションを使わず、vbaでfor文の入れ子状態＆条件一致を探した方がいいのかな・・・。
速くなる保証はないですけどね。

お礼

まだまだ初心者な為、条件を２つに減らして何度もトライしてみました。
以下、※で記した箇所の不明な点をお教えください。
何度も感謝いたします。

Sub daburi()
Dim k
Dim ws2, ws As Worksheet

’※条件２行（＋各フィールド行で計４行にしました）
Dim ct(100)

Set ws2 = Worksheets("2")
Set ws = Worksheets("sheet1")

’※上記の理由により１００から２へ変更
For k = 1 To 2

ws2.Cells.Clear
ws.Range("a201:ad10000").AdvancedFilter _
Action:=2, _
CriteriaRange:=Range("a" & 2 * k - 1, "a" & 2 * k), _
CopyToRange:=ws2.Range("A1")

’※この文は、結果のレコード数をカウントしてますか？
ct(k) = ws2.Range("a1").End(xlDown).Row

Next
ws2.Cells.Clear

’※上記の理由により１００から２へ変更
For k = 1 To 2

’※フィールド行も含めてカウントされるようです。（１件多い）
　※また、条件に合ったレコード件数を上から順に拾った結果が抽出されているみたいです。
　 カウントが目的だから問題ないでしょうか。
ws2.Cells(k, 1) = ct(k)
Next
End Sub

補足

ありがとうございます。

フィールド名は5列（部署列3＋カウントしたい項目列2～6）で条件は（斜めにOr指定）2～10行ずつで、100パターンとなります。
※カウントしたい部署が30ほどあり、カウントしたい列（項目）が1列のみ、2列分,3列分とあるので2～10行と変化します。
100条件×3パターンです。

先ずは参考にやってみます。
ダメなら詳細を添付します。

※速度よりもファイルサイズ重視です。

回答No.11

TAKA_R

10です。
あのコードでは、一括セレクション指定はできません。
こちょこちょと書き換えれば、セレクションでの指定はできますが・・・。
そのためには超えなければならない問題があります。

補足でaction:=1って何？とありますけれど、そのことと関係があります。
１はその場所にフィルタの結果を返す。フィルタではねられた行は非表示になり、オートフィルタをしたときと同じ結果となります。xlFilterInPlaceです。
２はフィルタをかけて、取り出された結果を指定の場所にコピーする。元データはそのまま残り、フィルタ結果の行番号は連番になります。オートフィルタ＋コピーと同じ結果です。xlFilterCopyです。
数字でも文字でも指定できます。

問題は100パタ－ン分の結果をどこに返すかです。
１パターン分ならその場に返せますが、それ以上の場合、そのままInPlaceしてしまうとその前までのパターンのフィルタ結果は全部なかったことになり、最後のパターンのフィルタの結果しか残りません。

お礼

ありがとうございます。
感謝します！

結果の数をカウントするのが目的なので、inplaceしてsubtotalした数値を別シートへ転記です。
100パターンのレコード数の件数が知りたいのです。

selectionを２行ずつ下にずらしていくoffset文にして、selectionを使ったadvancefilterを100行作成でよいでしょうか？

回答No.10

TAKA_R

解析中の最中、本当に申し訳ないんですけど。
お返事の条件でもっと楽な方法を見つけました。
ちなみに検索するデータ範囲は、適当につくろってください。
条件のセルを選択して、マクロを登録したスイッチを押してみてください。

Sub fil()
Worksheets("sheet1").Range("a4:ad2004").AdvancedFilter _
Action:=1, _
CriteriaRange:=Selection
End Sub

お礼

ありがとうございます。

今パソコンが手元にないのですが、条件部分をまとめて範囲をselectionした場合、1条件ずつ100パターンの結果が得られますか？

100パターンで抽出された結果をそれぞれ別ファイルに一部転記したいので。

条件部分には、

フィールド名
>＝20
フィールド名
>＝30
…

というような式が下に100パターン続いています。

補足

すいません。

action：1の1は何の変数ですか？

回答No.9

TAKA_R

7です。
２行落としたいとのことでしたが。
これは条件を書くためのワークシートの書き込みの位置に、空白行を含んでいても
配列は読み取れるかということでしょうか。
配列はセルが飛び飛びの場合、ここだと指定してやらないと配列に入れてやることができません。
（つまり「a=(範囲)」のように一括処理ができないんです）
逆に言えば、指定してやれば２行飛ばそうと、３行だろうと、ランダムでも問題ないです。
行頭に目印をつけておいてやると指定するときに楽になると思います。

おまけですが、何個ものパターンを同時処理する場合を除けば、２次配列ではなく１次配列の方が
分かりやすくてよいと思います。
１次のコードを作ってから、繰り返し処理で２次の処理を行ったほうが、バグも減りますしね。

あと、配列は配列名(i,5)ではなく、配列名(5,i)のほうがいいかもしれません。
(５はずっと変わらないとして)
配列の要素数に変更が生じたときに、書き直したくても対応しているのは最後の数字の部分だけです。

７で書いたコードに変更させたいところがあったので、直しておきます。
変更箇所：条件の列を計算する式を上のほうに持ってきた。
それを使って、ループの脱出条件を書いた。
これで、A列にaが書いてなくても使えます。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim hai(5)
Dim m
If Target.Column = 3 And Range("a" & Target.Row) = "0" Then
hai(0) = Worksheets("sheet1").Range("a1").End(xlDown).Row
If Range("d" & Target.Row + 1) = "" Then
hai(5) = 3
Else
hai(5) = Range("c" & Target.Row + 1).End(xlToRight).Column
End If
Do
m = m + 1
Loop Until Range(Cells(Target.Row + m + 1, 3), Cells(Target.Row + m + 1, hai(5))) = ""
Range("b33") = m
hai(2) = Target.Row + m
hai(1) = Target.Row + 1
hai(3) = Range("b" & Target.Row + 1)
hai(4) = Range("b" & Target.Row + 2)
Call fil(hai)
Else
Exit Sub

End If

End Sub

お礼

すいません。

解析に時間を要しています。

条件式は100パターンですが、空きはありません。
データと同じシート内に条件式もありますが、別シートでもいいと思います。
結果の出力はinplaceが希望です。

回答No.8

shinkami

ANo.１のsinnkamiです。
VBAでセルは
　Range("セル番地")と記述します。
　セル番地は　"A"　＆　I　のように編集できます　(i:数値変数)
希望のセルにせるを移動するには
Range("c1").Select

Sub サンプル()
For i = 1 To 20
Range("A" & i) = Range("A" & i) + i
Range("B" & i) = 100 * i
Next i
Range("c1").Select
End Sub

お礼

ありがとうございます。
参考にします。

回答No.7

TAKA_R

VBAで条件文を書く予定だったんですね。
手を抜くことばっかり考えてました・・・。
条件文はセルに書きこんだほうが楽。

手を抜いた作業がしたくなったら使ってみてください。

注）条件を書くためにシートを用意する必要があります。
参考例の画像を見てください。
グレーの部分は普段は非表示にしたら良いです。
メモはどんな条件かのメモ書きに。
水色の部分をダブルクリックしたら、操作します。
同じブック内での作業として考えてます。

ここから下end subまでを標準モジュールにコピペ

Sub fil(ByVal hai)
Worksheets("sheet2").Range("A1:ad" & hai(0)).AdvancedFilter _
Action:=2, _
CriteriaRange:=Range(Cells(hai(1), 3), Cells(hai(2), hai(3))), _
CopyToRange:=Worksheets(hai(4)).Range(hai(5)) 'sheet2はデータがあるワークシートを指定
End Sub

ここから下、end subまでを条件文を書いたシートのモジュールにコピペ

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim hai(5)
Dim m
If Target.Column = 3 And Range("a" & Target.Row) <> "" Then
hai(0) = Range("a1").End(xlDown).Row
hai(1) = Target.Row + 1
Do
m = m + 1
Loop Until Range("a" & hai(1) + m + 1) = a
hai(2) = hai(1) + m
If Range("d" & hai(1)) = "" Then
hai(3) = 3
Else
hai(3) = Range("c" & hai(1)).End(xlToRight).Column
End If
hai(4) = Range("b" & hai(1))
hai(5) = Range("b" & hai(1) + 1)
Call fil(hai)
End If
End Sub

回答No.6

TAKA_R

>条件が100パターンある場合の変数でブロックでくくる時、セルを変数（i,5）で指定すると下にずれていきますか？

ごめんなさい。私もかけだしなもので「何が」下にずれるのか類推できませんでした。
できれば前後の説明をお願いします。

お礼

ありがとうございます。
条件が100行ありますので、構文（一つのプロシージャ）毎に
2行ずつ下がってほしいのです。

条件１
月曜 野球

条件２
月曜 バレー

条件３
火曜 野球
…

ていう具合に100パターンの結果を出したいのです。

回答No.5

shinkami

ANo.１のsinnkamiです。

VBAのif文とSelect　Case文の　構文です
参考URLより抜粋しました。

if文の構文
Sub TEST4()
Dim GYO As Long
Dim strMSG As String

' 現在の行を取得する
GYO = ActiveCell.Row
' GYOは奇数か(Modは剰余を算出)
If (GYO Mod 2) <> 0 Then
strMSG = "この行は奇数、"
' さらに3で割り切れるか
If (GYO Mod 3) <> 0 Then
strMSG = strMSG & "でも3で割り切れない"
Else
strMSG = strMSG & "しかも3で割り切れる"
End If
Else
strMSG = "この行は偶数、"
' さらに3で割り切れるか
If (GYO Mod 3) <> 0 Then
strMSG = strMSG & "でも3で割り切れない"
Else
strMSG = strMSG & "けれど3で割り切れる"
End If
End If
MsgBox strMSG
End Sub

Select Case 文の構文
Sub TEST6()
' A1セルに評価点を入れる
Select Case Cells(1, 1).Value
Case 100: MsgBox "満点です。おめでとう！！"
Case 99: MsgBox "ほとんど満点です。おめでとう！！"
Case Is >= 95: MsgBox "おしい！！次でがんばろう！"
Case Is >= 90: MsgBox "上出来です。今度はもっとがんばろう！"
Case Is >= 80: MsgBox "一応、上位ですが「天狗」にならないように"
Case Is >= 50: MsgBox "中くらいです。"
Case Is >= 30: MsgBox "良くありません。"
Case Else: MsgBox "やり直してきなさい！"
End Select
End Sub

参考URL：

http://www.asahi-net.or.jp/~ef2o-inue/menu/menu04.html

回答No.4

TAKA_R

日本語がうまく伝わるか分かりませんが、「フィルタオプションを使って作業するけれど、設定・操作はVBA」というのはどうでしょう？
はじめてフィルタオプションを使ってみましたが、確かに条件式の書き換えは面倒ですね。

http://www.eurus.dti.ne.jp/yoneyama/Excel/vba/vba_advancedfilter.html
このサイトが役に立つかと思います。

変数で指定するとより便利とありますが、さらに配列を使うともっと便利に使えるでしょう。

お礼

ありがとうございます。

URLを参照させていただきました。
条件が100パターンある場合の変数でブロックでくくる時、セルを変数（i,5）で指定すると下にずれていきますか？