エクセル２００３ 条件分岐で困っています

質問

いつも回答して頂きとても感謝しています。

Inputboxに検索開始日と検索終了日を入力し、複数のブックにある履歴を1つのシートにまとめたいと思っています。ブックの履歴シートは各月毎に入力されていますが、先月分の履歴も含まれている場合がある為、その履歴シートをそのままつなげていった場合、重複する箇所が発生するため、検索する日付からセル位置（行）を特定して、コピーする領域を設定しようかと思っています。

で、困っている事は検索期間が複数のブックにまたがる時、次のブックの最初の日付をどのように条件分岐させて、『yyyy/m/1』にするかです。色々考えてはいますが、分からない為相談させて頂きました。宜しくお願い致します。

下記が作成中のマクロです。

Sub アラーム履歴一覧作成2()

Dim 開始1 As Date, 開始2 As Date, 開始3 As Date, 開始4 As Date
Dim 終了1 As Date, 終了2 As Date, 終了3 As Date
Dim Path1 As String, Path2 As String
Dim Buf1 As String, Buf2 As String
Dim File As String
Dim wb As Workbook

Dim 日付c As Long
Dim アラームc As Long

Dim 開始r As Long, 終了r As Long

Dim ws1 As Worksheet 'コピー元である引継書のアラーム履歴
Dim ws2 As Worksheet 'コピー先であるファイルのアラーム履歴仮置き場所

On Error GoTo errhandle
開始1 = InputBox("yyyy/mm/dd", "開始日設定画面")
On Error GoTo 0
If 開始1 > Date Then
MsgBox "現在の日付より開始日の方が新しい為検索出来ません。"
Exit Sub
End If

On Error GoTo errhandle
終了1 = InputBox("yyyy/mm/dd", "終了日設定画面")
On Error GoTo 0
If 終了1 > Date Then
MsgBox "現在の日付より終了の日付の方が新しい為検索出来ません。"
Exit Sub
ElseIf 開始1 >= 終了1 Then
MsgBox "現在の日付より終了の日付の方が新しい為検索出来ません。"
Exit Sub
End If

開始2 = 開始1

If Day(開始1) >= Day(終了1) Then
終了2 = DateAdd("m", 1, 終了1)
Else
終了2 = 終了1
End If

Do Until 開始2 >= 終了2
File = "aaa " & Format(開始2, "yyyy年m月")
Path1 = "C:\Users\Owner\Documents\"
Path2 = "C:\Users\Owner\Documents\" & Format(開始2, "yyyy年") & "\"

If Dir(Path1 & File & ".xlsx") <> "" Then
Buf1 = Dir(Path1 & File & ".xlsx")
For Each wb In Workbooks
If wb.Name = Buf1 Then
MsgBox Buf1 & vbCrLf & "はすでに開いています", vbExclamation
Exit Sub
End If
Next wb
Workbooks.Open Filename:=Path1 & File & ".xlsx"
ElseIf Dir(Path2 & File & ".xlsx") <> "" Then
Buf2 = Dir(Path2 & File & ".xlsx")
For Each wb In Workbooks
If wb.Name = Buf2 Then
MsgBox Buf2 & vbCrLf & "はすでに開いています", vbExclamation
Exit Sub
End If
Next wb
Workbooks.Open Filename:=Path2 & File & ".xlsx"
Else
MsgBox (File & "が存在しません！！")
Exit Sub
End If

Set ws1 = Workbooks(File).Worksheets("アラーム履歴")
Set ws2 = Workbooks("アラーム収集").Worksheets("アラーム履歴仮置き")

With ws2.Cells
.ClearContents
ws1.Cells.Copy
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End With
Workbooks(File).Close savechanges:=False

日付c = ws2.Rows(2).Find(what:="発生日時", LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByColumns, searchdirection:=xlNext).Column

ws2.Range("B2:P60000").Sort Key1:=Range("B2"), order1:=xlAscending, Header:=xlYes

日付c = ws2.Rows(2).Find(what:="発生日時", LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByColumns, searchdirection:=xlNext).Column

　　　'ここから先が分からない・・・

開始3 = Format(開始2, "yyyy年m月1日")
終了3 = Format(終了2, "yyyy年m月1日")

If 開始3 = 終了3 Then
開始4 = 開始2
ElseIf 開始3 < 終了3 Then

If 開始3 < 開始2 Then
開始4 = 開始2
Else
開始4 = 開始3
End If

Do While Application.CountIf(ws2.Columns(日付c), 開始4) = 0
If 開始4 < 終了2 Then
開始4 = DateAdd("d", 1, 開始4)
End If
Loop

開始r = ws2.Columns(日付c).Find(what:=開始4, LookIn:=xlFormulas, lookat:=xlWhole, _
searchorder:=xlByRows, searchdirection:=xlNext).Row

開始2 = DateAdd("m", 1, 開始2)

Loop

Exit Sub

errhandle:
MsgBox "日付を打ち込み直して下さい"

End Sub

回答No.3

oka_me

度々すみません 訂正です
下記回答内でmonth関数では年をまたいだ場合に対処できないかと思うので
適切と思われる方法（例えばformatでyyyymm等）に修正してください。。

詰めが甘くてすみませんm(_ _)m

お礼

oka_meさんの提案を参考にした所、自分が思った記述が出来ました。色々考えて下さり、ありがとうございました。

回答No.2

oka_me

#1です。

開始日の月と終了日の月の範囲外のデータまで抽出されてしまう、ということですかね。でしたら

【方法１】
オートフィルタの抽出条件を３つに増やす。
条件１：>= 開始1
条件２：>= 開始2の月の1日～（Format関数使用）
条件３：<= 終了1

オートフィルタで３つ以上の条件を設定する方法は
http://officetanaka.net/excel/vba/tips/tips155.htm
あたりが参考になるかと思います。

あるいは、
【方法２】
開始2の月が開始日と終了日に該当する場合、あるいは開始日と終了日が同月の場合のみ、IFで抽出条件を変える。

If Month(開始1) = Month(終了1) Then '開始日と終了日が同月の場合（開始日～終了日を抽出）
r.AutoFilter 日付c - 1, ">=" & 開始1, , "<=" & 終了1

Else '開始日と終了日が別の月の場合（さらに条件分岐）
If Month(開始2) = Month(開始1) Then '開始月の場合（開始日以降を抽出）
r.AutoFilter 日付c - 1, ">=" & 開始1
ElseIf Month(開始2) = Month(終了1) Then '終了月の場合（当月1日～終了日を抽出）
r.AutoFilter 日付c - 1, ">=" & Format(開始2, "yyyy/mm/01"), , "<=" & 終了1
Else 'その他（中間月・当月1日以降全て抽出）
r.AutoFilter 日付c - 1, ">=" & Format(開始2, "yyyy/mm/01")
End If
End If

ダミーデータを作るのが意外と手間なので検証はしていませんが(^^;)、とりあえずこんな感じで如何でしょうか。。
（不具合等あったら修正して下さい）

お礼

oka_meさんの提案を参考にした所、自分が思った記述が出来ました。色々考えて下さり、ありがとうございました。

回答No.1

oka_me

質問文のコードを全て読んで理解したわけではないと思うので見当違いだったら申し訳ありませんが

「先月分の履歴も含まれている場合がある為、その履歴シートをそのままつなげていった場合、重複する箇所が発生するため」

とのことでしたら、元ブックの日付の列で「開始日2」の月の1日～でオートフィルタをかけてコピーする方法では駄目でしょうか？

質問文を読んでの推測ですと
・元ブックのタイトル行は２行目B列～P列
・データは３行目～
・「発生日時」の列に日付が入力されている

かと思いましたので（間違っていたらすみません）、それを前提とすると

日付c = ws1.Rows(2).Find(what:="発生日時", Lookat:=xlWhole).Column
Set r = ws1.Range("b2:p" & Cells(Rows.Count, 日付c).End(xlUp).Row) '元シートのデータ範囲を格納
r.AutoFilter 日付c - 1, ">=" & Format(開始日2, "yyyy/mm/01") '該当月の1日～でオートフィルタ
ws1.Range("b3:p" & Cells(Rows.Count, 日付c).End(xlUp).Row).Copy 'データ部分のみコピー
ws2.Range("b" & Rows.Count).End(xlUp).Offset(1).PasteSpecial '貼り付け先ブックの既に存在するデータの下に貼り付け
（※rはRange型）

あくまで例ですので上手くアレンジしてください。
それ以前に見当違いになっているようでしたらご容赦下さいm(_ _)m

お礼

オートフィルターで日付の範囲を決める方法は思いつきませんでした。ありがとうございます。しかし、この場合でも範囲を決める日付をどうするか、まだまだ思いつきません。

補足

例１）開始日：2013/8/9 / 終了日：2013/10/6 としていた場合、

最初のブック『2013年8月』を開ける。この時は2013/8/9と2013/8/31の範囲でコピー。
次のブック『2013年9月』を開ける。この時は2013/9/1と2013/9/30の範囲でコピー。
次のブック『2013年10月』を開ける。この時は2013/10/1と2013/10/6の範囲でコピー。で終了。

例２）開始日：2013/8/9 / 終了日：2013/8/25 としていた場合、

最初のブック『2013年8月』を開ける。この時は2013/8/9と2013/8/25の範囲でコピー。で終了。

となるような作業が出来るループを考えています。
で、開始日と終了日を入力するだけでいける方法を考えていますが、各ブックのコピーする領域を決める最初の日付と最後の日付をどのように条件分岐させて決定させるかが上手くいかないので困っているのです。

宜しくお願い致します。