エクセル２００７のVBAでオートフィルタのチェック

質問

エクセル２００７のVBAでオートフィルタのチェックを閾値以上の％のみに入れたいのです。

　ユーザー設定フィルタでは視覚的に解りつらい為、フィルタの▽をクリックした時に、チェックがされている事を確認したいのです。

【シート１の内容】

セルA1から行方向に数字の１～３
セルB1から行方向に、値１、値２、％
セルA3～Bnは列方向に、整数
セルC3から列方向に、“=A3/B3”が入力されており、書式は　パーセンテージ（小数点以下の桁数は“１”）
セルD1に　閾値として　10.5%・・・書式はC3に同じ

【目的】

動きとしては、閾値以上の結果を出すつもりで書きました。

【質問】

フィルタがかかった▽をクリックした時に、１行、２行及びＣ列の10.5%以上のチェックボックスにチェックを入れたいのです。

しかし、下記コードの
.AutoFilter Field:=3, Criteria1:=Array("％") _
, Operator:=xlFilterValues, Criteria2:=Array(TargetCD)
でエラーが出てしまいます。

実行時エラー '1004':
Range クラスの AutoFilter メソッドが失敗しました。

Sub Threshol()
Dim MaxRow As Integer
Dim TargetCD
Dim CDDiff As Integer
Dim MinCD As Single
Dim MaxCD As Single
Dim i As Integer
Dim j As Single

MaxRow = Range("C1").End(xlDown).Row

With ActiveSheet.Range(Cells(3, 3), Cells(MaxRow, 3))
MinCD = ThisWorkbook.Worksheets(1).Range("D1").Value * 100
MaxCD = Application.Round(Application.Max(.Cells) * 100, 1)
CDDiff = (MaxCD - MinCD) * 10

ReDim TargetCD(1 To CDDiff + 1)
For i = 1 To UBound(TargetCD)
TargetCD(i) = FormatPercent(MinCD / 100 + j, 1)
j = Format(j + 0.001, "#.###")
Next
.AutoFilter Field:=3, Criteria1:=Array("％") _
, Operator:=xlFilterValues, Criteria2:=Array(TargetCD)
End With
End Sub

皆様、良いご助言を宜しくお願い致します。

回答No.4

cj_mover · ベストアンサー

いや、スミマセン。お騒がせしちゃって。
うっかり確認が漏れていました。
というより、私の当初の見立ては大きく外れていて、
これは、実際ＸＬ２００７環境で確認しないでいては、
そもそも無茶な話を振った私だったようです。

一応、2010での挙動と、問題点を挙げておきます。

　.AutoFilter Field:=1, Criteria1:=">=" & MinCD, Operator:=xlAnd
↑これは、
> 動きとしては、閾値以上の結果を出す...
という要求には適っていますが、
> フィルタの▽をクリックした時に、チェックがされている事を確認したいのです。
という要求からは外れています。

　.AutoFilter Field:=1, Criteria1:=TargetCD, Operator:=xlFilterValues
↑これは、
> フィルタの▽をクリックした時に、チェックがされている事を確認したいのです。
という要求には適っていますが、
> 動きとしては、閾値以上の結果を出す...
という要求からは外れています。
ご提示のコード、私があげた２種類、何れもうまくいきません。

> セルC3から列方向に、“=A3/B3”が入力されており、書式は　パーセンテージ（小数点以下の桁数は“１”）
表示上丸められた数字文字列が"10.5%"でも、実際の数値は10.5%未満のケースでは
閾値未満のものが抽出されてしまいます。
※ここら辺↑は仕様が変わっていそうなので、2007では違う結果なのかも知れませんが、、、。

例を挙げます。
(1)　　50／ 476＝0.10504
(2)　　50／ 477＝0.10482
(3)　　50／ 478＝0.1046
> 閾値以上
は(1)だけですが、
> パーセンテージ（小数点以下の桁数は“１”）
で表示させると、(1)(2)(3)ともに"10.5%"で
"10.5%"を Operator:=xlFilterValues でフィルターにかけると
(2)(3)も抽出されてしまいます。
　10.5%未満の値で表示が"10.5%"のセルについては
　　10.5%以上の値で表示が"10.5%"のセルの有無によって
　　抽出されたりされなかったり、という結果になってしまいます。

比較的小さい数字で 10.5%未満の値で表示が"10.5%" になる例を挙げると
　　9／ 86＝0.10465
　　11／ 105＝0.10476
　　13／ 124＝0.10484
　　15／ 143＝0.1049
　　16／ 153＝0.10458
　　17／ 162＝0.10494
　　18／ 172＝0.10465
　　19／ 181＝0.10497
　　20／ 191＝0.10471
　　. . .
結構、ありますね。

私がわかってないだけで（←仕様の違い、と、仕様そのもの）
何か、方法が別にあるのかも知れませんが、今私が知る限りでは、
> 動きとしては、閾値以上の結果を出す...
> フィルタの▽をクリックした時に、チェックがされている事を確認したいのです。
ふたつの要求を同時に満たす為には、
Ｃ列の値（数式での丸め方、丸める桁）や表示（小数点以下の桁数）の方を工夫すること
しか、思い浮かびません。
（↑10.5%未満の値で表示が"10.5%"のセル と 10.5%以上の値で表示が"10.5%"のセル
　とが、見かけ上、異なる表示になるようにする、という意味です）

ということで、お騒がせしたわりに、
私の回答では、要求仕様に応えるものが提示出来ていないようなのです。
申し訳ありません。他の回答をお待ちください。

お礼

cj_moverさま

　深夜までご検討下さり、誠にありがとうございます。
代案の丸め方で再検討してみます。

　今回も大変勉強になりました！！

補足

cj_moverさま

　おはようございます。

　閾値１０．５％のままで、Ｃ列が１０．４５＃＃＃＃％以上であれば、Ｃ列の見かけ上の１０．５％を抽出＆フィルタチェックが行えれば良いと考え、（今までもそこまでは厳密にしていなかったので。。。）

ご回答頂いた、＃３のSub Threshol_jj()の内、
　MinCD = .Range("D1").Value - 0.0005
であれば、見かけ上ですが私の仕様を満足出来そうです。（本当に良いのかなとは思いますが）

cj_moverさまとしては、いかが思われますでしょうか？

回答No.3

cj_mover

たびたびすみません、再度＃１の訂正です。
"以上" を "より大きい" と思い込んでしまっていましたので
拙コード、不適切でした。
２か所、２文字ですが、プロシージャごと加筆再掲します。

Sub Threshol_j()
　　Dim TargetCD
　　Dim MinCD
　　Dim MaxRow As Long
　　Dim i As Integer

　　Dim Target As Range ' "＞＝閾値"で抽出済みの範囲
　　Dim r As Range ' Target 全セル ループ用
　　Dim CntTgt As Long ' "＞＝閾値"で抽出された個数

　　With ActiveSheet
　　　　.AutoFilterMode = False
　　　　MaxRow = .Range("C1").End(xlDown).Row
　　　　MinCD = .Range("D1").Value
　　　　With .Range("C2:C" & MaxRow)
　　　　　　.AutoFilter Field:=1, Criteria1:=">=" & MinCD, Operator:=xlAnd
　　　　　　Set Target = .SpecialCells(xlCellTypeVisible)
　　　　　　CntTgt = Target.Count
　　　　　　ReDim TargetCD(1 To CntTgt)
　　　　　　For Each r In Target
　　　　　　　　i = i + 1
　　　　　　　　TargetCD(i) = r.Text
　　　　　　Next r
　　　　　　.AutoFilter Field:=1, Criteria1:=TargetCD, Operator:=xlFilterValues
　　　　End With
　　End With
　　Set Target = Nothing
End Sub

Sub Threshol_jj()
　　Dim TargetCD
　　Dim MinCD As Variant
　　Dim MaxRow As Long
　　Dim r As Range ' ループ用

　　With ActiveSheet
　　　　.AutoFilterMode = False
　　　　MaxRow = .Range("C1").End(xlDown).Row
　　　　MinCD = .Range("D1").Value
　　　　With .Range("C2:C" & MaxRow)
　　　　　　For Each r In .Cells
　　　　　　　　If r.Value >= MinCD Then TargetCD = TargetCD & " " & r.Text
　　　　　　Next r
　　　　　　TargetCD = Split(Mid(TargetCD, 2))
　　　　　　.AutoFilter Field:=1, Criteria1:=TargetCD, Operator:=xlFilterValues
　　　　End With
　　End With
End Sub

＃２００７で使えれば、、、の話ですが(^^;

お礼

度重なるご回答ありがとうございます。

">="の部分は、私も修正してトライしておりました。
しかし、既に御気付きの通り＃４の御回答の通りの結果となりました。

回答No.2

cj_mover

すみません。＃１の訂正です。///

> 確認事項５■
ご提示の TargetCD は、配列。
Array()関数 は、Array("10.6%", "10.7%", "10.8%") のように
個々の値を指定しながら配列を作る時に使う関数。
Array()関数 の引数に配列を指定すると、返ってくるのは、
配列の中身が配列 になっている二段階配列（ジャグ配列）。
Criteria に指定する 配列 は一次元で十分なので
Array(TargetCD) は単に TargetCD で足ります。

///

それと、
ＸＬ２００７ と ＸＬ２０１０ で、フィルターの仕様が
いろいろと異なっていることだけは承知しているのですが、
こちらでは2010しか確認できる環境がないので、
もし、頓珍漢な答えになっていた場合は、ごめんなさい。

お礼

再度のご確認ありがとうございます。
＃１で動作はＸＬ２００７でも確認出来ました。

回答No.1

cj_mover

こんにちは

確認事項１■
　? Range("D1").Value -> 0.105
　? Range("D1").Text -> "10.5%"
今回抽出対象として扱うのは数値。
表示形式の如何を問わず、皆、数値です。

確認事項２■
.AutoFilter の引数 Criteria に指定する 配列 の中身は、文字列。
Range("any").Text で取得できるセルの表示内容（文字列）と同じものです。

確認事項４■
.AutoFilter で、タイトルを抽出条件に加えるのは必要ではないです。

確認事項５■
ご提示の TargetCD は、配列。
Array()関数 は、Array("9.9", "10.4", "10.6") のように
個々の値を指定しながら配列を作る時に使う関数。
Array()関数 の引数に配列を指定すると、返ってくるのは、
配列の中身が配列になっている二次元配列。
Criteria に指定する 配列 は一次元で十分。
Array(TargetCD) は単に TargetCD で足ります。

確認事項５■
１列のRangeオブジェクトにAutoFilterを指定するのに
> Field:=3
とすれば存在しない３列めを指定していることになり、エラーになります。

ご質問に対する直接的な回答■
> しかし、下記コードの
> .AutoFilter Field:=3, Criteria1:=Array("％") _
> , Operator:=xlFilterValues, Criteria2:=Array(TargetCD)
> でエラーが出てしまいます。
>
> 実行時エラー '1004':
> Range クラスの AutoFilter メソッドが失敗しました。

　.AutoFilter Field:=1, Criteria1:=TargetCD, Operator:=xlFilterValues
で、いける筈です。

> j = Format(j + 0.001, "#.###")
この行の意図は汲み取れませんでした。

備考■
実在しているかどうかわからない値を Criteria 配列 に指定するのは必要以上のこと。
データによっては負荷が大きすぎちゃうんじゃないでしょうか。。

実在する値だけを追うように書いてみました（２種類）。
尚、当方、Excel2010にて動作の確認をしています。

１）一旦、"＞閾値"で、フィルターをかけ、
　可視セル（抽出されたセル）を取得し、
　セル数を取得→配列のサイズを再定義→各セルの表示文字列を配列に要素に設定。

Sub Threshol_j()
　　Dim TargetCD
　　Dim MinCD
　　Dim MaxRow As Long
　　Dim i As Integer

　　Dim Target As Range ' "＞閾値"で抽出済みの範囲
　　Dim r As Range ' Target 全セル ループ用
　　Dim CntTgt As Long ' "＞閾値"で抽出された個数

　　With ActiveSheet
　　　　.AutoFilterMode = False
　　　　MaxRow = .Range("C1").End(xlDown).Row
　　　　MinCD = .Range("D1").Value
　　　　With .Range("C2:C" & MaxRow)
　　　　　　.AutoFilter Field:=1, Criteria1:=">" & MinCD, Operator:=xlAnd
　　　　　　Set Target = .SpecialCells(xlCellTypeVisible)
　　　　　　CntTgt = Target.Count
　　　　　　ReDim TargetCD(1 To CntTgt)
　　　　　　For Each r In Target
　　　　　　　　i = i + 1
　　　　　　　　TargetCD(i) = r.Text
　　　　　　Next r
　　　　　　.AutoFilter Field:=1, Criteria1:=TargetCD, Operator:=xlFilterValues
　　　　End With
　　End With
　　Set Target = Nothing
End Sub

２）Ｃ列２行目から最下行まで、全セルをループして
　閾値より大きい値を持つセルの表示文字列を " "半角スペース区切りで連結した文字列
　を Split() 関数を使って配列にします。
　（簡素化する為に、タイトル"%"の分だけ余計な条件を加えたままにしています）

Sub Threshol_jj()
　　Dim TargetCD
　　Dim MinCD As Variant
　　Dim MaxRow As Long
　　Dim r As Range ' ループ用

　　With ActiveSheet
　　　　.AutoFilterMode = False
　　　　MaxRow = .Range("C1").End(xlDown).Row
　　　　MinCD = .Range("D1").Value
　　　　With .Range("C2:C" & MaxRow)
　　　　　　For Each r In .Cells
　　　　　　　　If r.Value > MinCD Then TargetCD = TargetCD & " " & r.Text
　　　　　　Next r
　　　　　　TargetCD = Split(Mid(TargetCD, 2))
　　　　　　.AutoFilter Field:=1, Criteria1:=TargetCD, Operator:=xlFilterValues
　　　　End With
　　End With
End Sub

以上、ご参考になれば。

お礼

早速のご回答誠にありがとうございます。
現実的には、２００列程あり、それぞれフィルターの値を選択し、（フィルターを掛け、値を取得し
更にフィルターを掛け文字を取得し…）と何回かの過程を経て最終値を別のＢｏｏｋに反映するのが
目的なのです。

＞確認事項１～２、４■
　大変参考になりました。

＞確認事項３■
＞.AutoFilter で、タイトルを抽出条件に加えるのは必要ではないです。
　２列目全てにフィルタを掛けると文字列が▽で見えなくなるのと、２列目の文字を検索するよりも
１列目の数字で検索するのが私としてはやりやすいので、タイトル（２列目）も条件に加えたいのです。

＞確認事項５■
＞１列のRangeオブジェクトにAutoFilterを指定するのに
＞> Field:=3
＞とすれば存在しない３列めを指定していることになり、エラーになります。
　前述の通り、実際は３列目では無く、質問を簡略コードに書き換えておりました。
もっと具体的且つ詳細に質問するべきでした。すみません。

＞> j = Format(j + 0.001, "#.###")
＞この行の意図は汲み取れませんでした。
　私のコードで確認した時に、最初は　j = j + 0.001　でしたが、j の値が　１回目で
0.9####### と表示されたので、フォーマットしました。

＞備考■
＞実在しているかどうかわからない値を Criteria 配列 に指定するのは必要以上のこと。
＞データによっては負荷が大きすぎちゃうんじゃないでしょうか。。
　おっしゃる通りでございます。-100.0%未満も含まれる事があるのですが、最近質問したご回答を
引用出来るかなと思い。。。なにぶん超初心者なもので・・・

皆さんはどこでどうやってＶＢＡを勉強されたのでしょうか？？
私は、マクロを記録し、類似した質問を検索しカット＆トライでなんとか効率を上げている事務員で
御座います＾＾；