マクロ エクセル２００３ Sort
いつも回答して頂きとても感謝しています。
エクセル２０１０で作成した記述を、ほぼそのままエクセル２００３に書き写し実行した所、Sortの箇所でエラーが発生しました。 これはLoop中に実行しており、Loop1回目はエラーは発生しませんでしたが、Loop2回目ではエラーが発生しました。
確認の為、エクセル２０１０で実行した所、エラーは発生しませんでした。
いまいち原因が分からないので、間違いや抜けている箇所があれば教えて下さい。宜しくお願い致します。
問題のマクロの記述を一部下記に記載。
※問題の記述の箇所は一番下にあります。
Dim 開始1 As Date, 開始2 As Date, 開始3 As Date
Dim 終了1 As Date, 終了2 As Date
Dim 最初 As Date, 最後 As Date
Dim Path1 As String, Path2 As String
Dim Buf1 As String, Buf2 As String
Dim File As String
Dim 日付c As Long
Dim 項目c1 As Long, 項目c2 As Long
Dim c As Long
Dim MaxR As Long, MaxC As Long
Dim wb As Workbook
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
Set ws2 = Workbooks("アラーム収集").Worksheets("アラーム履歴一覧")
MaxR = ws2.Cells(Rows.Count, 2).End(xlUp).Row
If ws2.Cells(3, 3) <> "" Then
ws2.Rows("3:" & MaxR).ClearContents
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("アラーム履歴")
If 開始1 = 開始2 Then
最初 = 開始1
Else
最初 = Format(開始2, "yyyy/m/1")
End If
If 終了1 < Format(DateAdd("m", 1, 開始2), "yyyy/m/d") Then
最後 = 終了1
Else
開始3 = Format(開始2, "yyyy/m/1")
最後 = DateAdd("d", -1, DateAdd("m", 1, 開始3))
End If
With ws1
MaxR = .Cells(Rows.Count, 2).End(xlUp).Row
MaxC = .Cells(2, Columns.Count).End(xlToLeft).Column
日付c = .Rows(2).Find(what:="発生日時", LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByColumns, _
searchdirection:=xlNext).Column
.Range(.Cells(2, 日付c), .Cells(MaxR, MaxC)).Sort _ ← 問題の箇所
Key1:=.Cells(2, 日付c), order1:=xlAscending, Header:=xlYes
お礼
かなり長いマクロだったので全部読んでいただくのが悪い気がして簡単に書きすぎました。もう少し表現が上手になるよう努力します。 Application.Cursor = xlDefaultをメッセージの直前に挿入したら砂時計は出なくなり、無事次へ進めることができました。ありがとうございます。