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

Question

エクセル２００７の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

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

cj_mover · Accepted Answer

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

一応、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 · Answer

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

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

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

cj_mover · Answer

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

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

///

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

cj_mover · Answer

こんにちは

確認事項１■
　? 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

以上、ご参考になれば。

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

いや、スミマセン。

この回答への補足

たびたびすみません、再度＃１の訂正です。

すみません。

こんにちは

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング