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

質問

エクセル２００７のVBAでオートフィルタのチェックを特定の日付のみに入れたいのです。
（同様の質問をしておりますが、質問の意図が伝わらなかった、意味不明だったのか、ご検討中なのか、こちらで再度質問させて頂きます。）
　ユーザー設定フィルタでは視覚的に解りつらい為、フィルタの▽をクリックした時に、チェックがされている事を確認したいのです。

【シート１の内容】

セルA1から行方向に数字の１～４
セルB1から行方向に、日付、値１、値２、％　’日付は過去１年～未来１年分です。
セルA3から列方向に、書式は　yyyy/m/d
セルB3とC3から列方向に、ランダムな整数
セルD3から列方向に、“=B3/C3”が入力されており、書式は　パーセンテージ（小数点以下の桁数は“１”）
セルF2に　2012(年)、セルG2に　9(月)、セルH2に　閾値として　10.5%

【目的】

動きとしては、過去１年前～２０１２年９月末日までのデータの内、閾値以上の結果を出すつもりで書きました。

【質問】

フィルタがかかった▽をクリックした時に、指定した範囲の日付チェックボックスにチェックを入れたいのです。

試行錯誤の状態のコードで失礼します。
Selection.AutoFilter Field:=1, Criteria1:=Array("日付"), Operator:=xlFilterValues, _
Criteria2:=Array(buf)
この部分のbufの記述方法が、わかりません。

Sub Sample1()

Dim TargetDate As Date
Dim YY As Integer
Dim MM As Integer
Dim DD As Date
Dim EoD As Integer
Dim MaxRow As Integer
Dim i As Integer
Dim buf As Variant

Selection.AutoFilter

YY = ActiveSheet.Range("F2").Value
MM = ActiveSheet.Range("G2").Value
DD = YY & "/" & MM & "/1"
EoD = Day(DateAdd("d", -1, DateAdd("m", 1, DD)))

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

TargetDate = YY & "/" & MM & "/" & EoD
'TargetDate = Format(YY & "/" & MM & "/" & EoD, "m/d")
'TargetDate = DateValue(YY & "/" & MM & "/" & EoD)
'MsgBox TargetDate

For i = 3 To MaxRow
With Worksheets("Sheet1").Cells(i, 4)
.Activate
.FormulaR1C1 = "=R[-0]C[-2]/R[-0]C[-1]"
.Style = "Percent"
.NumberFormatLocal = "0.0%"
End With
Next i

buf = ""

For d = 0 To 365

' If d = 0 Then
' buf = "2, " & """" & TargetDate - d & """"
' ElseIf d >= 1 Then
' buf = buf & ", 2, " & """" & TargetDate - d & """"
' End If

' If d = 0 Then
' buf = "2, " & """" & Format(TargetDate - d, "m/d/yyyy") & """"
' ElseIf d >= 1 Then
' buf = buf & ", 2, " & """" & Format(TargetDate - d, "m/d/yyyy") & """"
' End If

'buf = buf & " 2, " & """" & Format(TargetDate - d, "yyyy/m/d") & """"
'buf = buf & " 2, " & """" & DateValue(TargetDate - d) & """"
'buf = buf & "2, " & """" & DateValue(TargetDate - d) & """"

'If d <> 365 Then
' buf = buf & """" & DateValue(TargetDate - d) & """" & ", "
'Else
' buf = buf & """" & DateValue(TargetDate - d) & """"
'End If

If d <> 365 Then
buf = buf & """" & TargetDate - d & """" & ", "
Else
buf = buf & """" & TargetDate - d & """"
End If

'Range("N1") = buf
Next d

Range("A1").Select
Selection.AutoFilter

Selection.AutoFilter Field:=1, Criteria1:=Array("日付"), Operator:=xlFilterValues, _
Criteria2:=Array(buf)　　　'ここでエラーを検出してます。
'Criteria2:=Array(2, "2012/3/5", 2, "2012/08/11", 2, "2014/5/6")

End Sub

皆様、良いお知恵をお貸し下さい。。。
OSは、WinXPとWin７共動いて欲しいです。
宜しくお願い致します。

回答No.1

end-u · ベストアンサー

こちらを参考にされると良いかと思います。
http://officetanaka.net/excel/vba/tips/tips151.htm

以下はサンプルコード。
Sub sample() 'sampleBook作成からCall test
　　With Workbooks.Add(xlWBATWorksheet).Sheets(1)
　　　　.Range("A1").Value = "field1"
　　　　.Range("A2").Value = #7/1/2012#
　　　　.Range("A2").AutoFill .Range("A2:A100")
　　End With
　　Stop '確認用
　　Call test
End Sub

Sub test()
　　Dim d1 As Date
　　Dim d2 As Date
　　Dim d　As Date
　　Dim n　As Long
　　Dim i　As Long
　　Dim j　As Long
　　Dim v

　　With ActiveSheet.Range("A1:A100")
　　　　d1 = Application.Min(.Cells)
　　　　'月単位
　　　　d2 = #9/1/2012#
　　　　n = DateDiff("m", d1, d2)
　　　　ReDim v(1 To n * 2)
　　　　For i = 1 To UBound(v) Step 2
　　　　　　d = DateAdd("m", j, d1)
　　　　　　j = j + 1
　　　　　　v(i) = 1 '※
　　　　　　v(i + 1) = d
　　　　Next
　　　　.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=v
　　　　Stop

　　　　'日単位
　　　　d1 = #7/11/2012#
　　　　d2 = #8/11/2012#
　　　　n = DateDiff("d", d1, d2)
　　　　ReDim v(1 To n * 2)
　　　　j = 0
　　　　For i = 1 To UBound(v) Step 2
　　　　　　d = DateAdd("d", j, d1)
　　　　　　j = j + 1
　　　　　　v(i) = 2 '※
　　　　　　v(i + 1) = d
　　　　Next
　　　　.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=v
　　End With
End Sub

お礼

end-uさん、いつもお世話になります。
お忙しい中、早速のご回答ありがとうございます。

貴officetanakaのページはとても参考になります。
　ご紹介頂いたページも既に見ておりましたが（熟読出来てない？）、私に基本的な
基礎が無くカットアンドトライ・コピペ・コピペ・質問・質問・カットアンドトライなのです。
　ＶＢＡに手を出すべきではない・・・のかも。orz（真似）
ご提示頂いたコードもレベルが高いです。

ですが！がんばります！

まずは、お礼まで＾＾

補足

end_uさん、こんばんは
'月単位を使用し、終了日は変数にしたかったので
d2 = CDate(YY & "/" & MM & "/" & EoD) + 1
で上手く行きました。ありがとうございます＾＾

ところで、後学の為に教えて欲しいのですが、
ReDim v(1 To n * 2)
For i = 1 To UBound(v) Step 2
これはｎを２倍して、ｉを１つ飛びにしているのは何故でしょうか？

また、'※は月単位と日単位で数値が異なるのでしょうか？

宜しくご教示願います。

回答No.2

end-u

#>宜しくご教示願います。
#締め切られたら追加レスできないです。気をつけましょう。

既に紹介した田中亨氏のwebページ
http://officetanaka.net/excel/vba/tips/tips151.htm
ここの最下部見てください。
日付フィルタの条件は１次元配列で指定します。

配列(条件１の数値,条件１の日付データ,条件２の数値,条件２の日付データ,…)
　　(1,#2012/06/01#,1,#2012/07/01#,…)

配列の最初から、１条件あたり２個１組で指定するわけです。

Sub sample()
　　Dim d1 As Date
　　Dim d2 As Date
　　Dim d　As Date
　　Dim n　As Long
　　Dim i　As Long
　　Dim j　As Long
　　Dim v

　　d1 = #6/1/2012#
　　d2 = #9/1/2012#
　　n = DateDiff("m", d1, d2)
　　MsgBox n & " ヶ月分"
　　ReDim v(1 To n * 2)
　　For i = 1 To UBound(v) Step 2
　　　　'DateAdd("m"..つまり月を増分させる。
　　　　d = DateAdd("m", j, d1)
　　　　j = j + 1
　　　　v(i) = 1
　　　　v(i + 1) = d
　　Next
　　For i = 1 To UBound(v)
　　　　Debug.Print v(i)
　　Next
　　Stop
End Sub

Stopで止まった時、VBE画面で[Alt]→[v]→[s]キー順押し、
[ローカルウィンドウ]を表示させてください。
配列 v の左、田マーククリックで 配列の中身が展開します。

v(1)　1
v(2)　#2012/06/01#
v(3)　1
v(4)　#2012/07/01#
v(5)　1
v(6)　#2012/08/01#

この配列を作る為に、3ヶ月分の条件の場合は
3×2の 6要素のサイズの１次元配列を準備し、
Loop時に１つ飛ばしで
v(i) = 1
v(i + 1) = d
２要素ずつ値をセットしてるわけです。

>また、'※は月単位と日単位で数値が異なるのでしょうか？
これも前述のページに書いてありますから読んでくださいね。
<引用>
0：後ろに指定した日付の年
1：後ろに指定した日付の月
2：後ろに指定した日付の日
3：後ろに指定した時刻の時
4：後ろに指定した時刻の分
5：後ろに指定した時刻の秒
</引用>

お礼

end-uさま

ご丁寧な解説をありがとうございます。
ｇｏｏ質問のやり方すら知らなくて、「補足」に「補足」を追加したらレスは出来なくなる事を知り、ＢＡを付けてしまいました。

それを、サポート担当様へ追加メールのお手数までお掛けし、誠に感謝致します。

また、サポート担当様も掲載のご検討頂きありがとうございました。この場でお礼を申し上げます。

＞<引用>・・・以下
この部分も見ていて、月は１、日は２が必要なのか…と思ってはいましたが、配列格納時に
(1,#2012/06/01#,1,#2012/07/01#,…)の
","が自動で入る（格納される）のを知らなかった為、理解出来ていませんでした。。。
それ故、どこがどうなっているのか更に混乱してしまいました。

本当にありがとうございました！