Excel VBAでの日付検索について

Excel VBAでの日付検索について

Excelに下記のように１時間おきの日時(A列)と値(B列)が数か月分入力されています。
UserFormで入力された月の、日別の合計した値を別ブックに出力したいと思っています。
A列の日時は、セルの書式設定でユーザ定義の「yyyy/m/d hh:mm」となっています。

例）UserFormで8月と入力されたら、8/1の0:00～23:00の値(B列)を合計し、別ブックへ出力し、それを月末(8/31)分まで繰り返し計算し出力したい。


A　　　 　　　　　　　 B
2010/8/1 0:00 　　　　　 345.5
2010/8/1 1:00 　　　　　 309.4
2010/8/1 2:00 　　　　　 364.2
: 　　　　　 :
: 　　　　　 :
: 　　　　　 :
2010/8/1 23:00 　　　　　 359.0
2010/8/2 0:00 　　　　　 339.9
2010/8/2 1:00 　　　　　 357.3



現在、下記のようなVBAにして、UserFormで入力された月の１日のデータが入力されている行番号を取得
しようとしているのですが、うまく検索されません。
どなたかご教授下さい。


Dim Obj As Object
Dim HitRow As Long
Dim Cerday As Long
Dim myDay As Date

myDay=txt_年.Value & "/" & txt_月.Value & "/1"

Cerday=DateValue(myDate)

Set Obj=Worksheets("sheet1").Cells.Find(Cerday,LookAt:=xlwhole)
If Obj Is Nothing Then
MsgBox "見つかりません。"
Else
HitRow=Worksheets("sheet1").Cells.Find(Cerday,LookAt:=xlwhole).Row
End If

No.1 回答者： kmetu 回答日時： 2010/09/26 20:40

Dim Cerday As Variant

にしてください。
また

Cerday=DateValue(myDate)
↓
Cerday=DateValue(myDay)

ではないでしょうか。

No.2 ベストアンサー 回答者： kmetu 回答日時： 2010/09/26 20:57

時間も同一セルにあるのを見落としてました

Dim myDay As String

myDay = txt_年.Value & "/" & txt_月.Value & "/1*"

Set Obj = Worksheets("sheet1").Cells.Find(myDay, LookAt:=xlWhole)


にしてください。

あとループして全て探し出さないとダメなんじゃないでしょうか

With Worksheets("sheet1").Range("a:a")
Set Obj = .Find(myDay, LookIn:=xlValues)
If Not Obj Is Nothing Then
firstAddress = Obj.Address
Do
Debug.Print Obj.Row
Set Obj = .FindNext(c)
Loop While Not Obj Is Nothing And Obj.Address <> firstAddress
End If
End With

No.3 回答者： ki-aaa 回答日時： 2010/09/27 12:20

こんにちわ、もう解決してるかもしれないけど

Sub test11()

Dim Obj As Range

Dim HitRow As Long
Dim Cerday As String
'String　に変える
Dim myDay As Date

With Worksheets("Sheet1")

myDay = DateValue("2010/08/01")

Cerday = Application.Text(myDay, .Range("A2").NumberFormat)
'表示形式をセルのものと合わせる　↑
MsgBox Cerday

Set Obj = .Range("A:A").Find(Cerday, LookAt:=xlWhole, LookIn:=xlValues)
'LookIn:=xlValues　を指定する。
If Obj Is Nothing Then
MsgBox "見つかりません。"
Else
MsgBox Obj.Address
HitRow = Obj.Row
End If

End With

End Sub

'************************************************

Sub test22()

Dim HitRow As Long
Dim Cerday As Long

With Worksheets("Sheet1")
Cerday = DateValue("2010/8/1")
MsgBox Cerday

On Error Resume Next
HitRow = Application.WorksheetFunction.Match _
(Cerday, .Range("A:A"), 0)
'Cells を　Range("A:A")に変える Cellsではだめ
If Err.Number <> 0 Then
MsgBox "見つかりません。"
Else
MsgBox HitRow
End If
On Error GoTo 0
End With
End Sub