VBA修正お願いします。

質問

下記のコードの日付の2011の箇所を2010/6/01～2012/4/01といったように月単位での条件にしたいのですが
どこをどうやって変えればいいですか？お詳しい方よろしくお願いします。

Sub カウント2012()
Dim dic As Object
Dim lastRow As Long
Dim r As Long
Dim key As String
Set dic = CreateObject("Scripting.Dictionary")
lastRow = Range("A" & Rows.Count).End(xlUp).Row
For r = 2 To lastRow

If Year(Cells(r, "C").Value) = 2011 Then

key = Range("A" & r).Value & Chr(0) & Range("W" & r).Value
If Not dic.exists(key) Then 'キー値が無ければ
dic.Add key, 1 'キーを追加して、値(個数)を１に
Else '既にキー値があれば
dic(key) = dic(key) + 1 'そのキーの値(個数)+1
End If

End If '★追加
Next
'表示
For r = 2 To lastRow
key = Range("A" & r).Value & Chr(0) & "1" '探す値はA列注目行の値+"1"(間にchr(0))
Range("FV" & r).Value = dic(key)
Next
End Sub

回答No.1

cj_mover · ベストアンサー

こんにちは。

Ｃ列が正しく日付値ならば、ですが、
If Year(Cells(r, "C").Value) = 2011 Then

End If
の部分を以下のいづれかに替えてみたらよいかと。

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
If Cells(r, "C").Value >= #6/1/2010# And Cells(r, "C").Value <= #4/1/2012# Then

End If
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Dim dtTgt As Date
dtTgt = Cells(r, "C").Value
If dtTgt >= #6/1/2010# And dtTgt <= #4/1/2012# Then

End If
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Const DT_MIN = #6/1/2010#
Const DT_MAX = #4/1/2012#
Dim dtTgt As Date
dtTgt = Cells(r, "C").Value
If dtTgt >= DT_MIN And dtTgt <= DT_MAX Then

End If
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Dim dtMin As Date
Dim dtMax As Date
Dim dtTgt As Date
dtMin = #6/1/2010# ' 日付値が指定出来れば方法は問わず。
dtMax = #4/1/2012# ' 同上
dtTgt = Cells(r, "C").Value
If dtTgt >= DT_MIN And dtTgt <= DT_MAX Then

End If
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

尚、変数を宣言する場合はプロシージャの先頭に書いてください。念の為。

以上です。

お礼

すごく細かなところまでありがとうございました。
すごく勉強になりました。