Q&A
とりあえず、困っていることの２つ目は、
Catch:の前にExit Sub を書いていないからでしょう。
3日前に仕事で急にVBAを使ってデータの処理をしなければならなくなり、Webでいろいろ調べてデータをフィルターし、ソートをするマクロを作ったのですが、エラーが解決できなくて困っています。
お力を貸してほしいです。(VBA初心者です)
やりたいこと
マクロを設定したボタンを押すと[予定表]シートに設定してある日付でフィルターをかけ、
結果を「抽出」シートに張り付け、時間列で昇順にソートをかける。
その後、「抽出」のデータを[予定表]に時間毎にわけて表示する。
困っていること
現在、困っていることは２つ。
１．AutoFilterを記述しているSchedule1マクロを開始すると、1度目は必ずエラーになる。
エラー内容：番号1004 詳細：RangeクラスのAutoFilterメソッドが失敗しました。 関数：Schedule1
5/20追記
上記のエラーが発生している箇所がわかりました。
以下のコードを実行したところでエラーが発生します。
'セットされた日付でオートフィルをかける Range("A1").AutoFilter field:=13, Criteria1:=Format(second, "m月d日") コード
２．しかし、再度Schedule1マクロを実行すると正常に最後まで処理が終了するが、正常に処理が終了後、再度エラーメッセージが表示される。
エラー内容；番号：0 詳細： 関数FirstDaySort
教えてほしいこと
１．エラーの原因と解決方法を教えてほしい。
２．データ件数が現在2700件ほどあり、処理時間が10秒ほどかかる。これから毎日300件ずつ増える予定なので、少しでも処理時間を短くしたい。短くするにはどうすればよいか。
３．ソートのマクロをソートする列が違っても共有して使えるようにしたいが、どうすれば実現できるか。
ファイルの環境
シート３つ：[予定表][データ一覧][抽出]
Option Explicit Sub Schedule1() 'データを日付でフィルターし、時間列で昇順にソートをかける On Error GoTo Catch Dim day1 As Date, first As String Application.ScreenUpdating = False '画面の表示を止める Sheets("抽出").Select Cells.Clear Sheets("予定表").Select day1 = Range("L2").Value first = CStr(day1) 'Date型を文字列に変更(5/1⇒5月1日でフィルターをかけるため) ' Sheets("データ一覧").Select Range(Range("A2"), Cells(Rows.Count, 1).End(xlDown)).AutoFilter '上から最終行を検索 'セットされた日付でオートフィルをかける(〇月〇日) Range("A1").AutoFilter field:=9, Criteria1:=Format(first, "m月d日") 'オートフィルの結果をコピーする Range("A1", Range("W1").End(xlDown)).SpecialCells(xlCellTypeVisible).Copy '書式と共にコピーする Sheets("抽出").Range("A1").PasteSpecial Paste:=xlPasteAll '予約時間①でソートをかける Sheets("抽出").Select Call FirstDaySort Worksheets("データ一覧").AutoFilterMode = False '念のためフィルタを解除 Application.ScreenUpdating = True '画面を再表示する MsgBox "処理が終了しました" Exit Sub Catch: Call LogErrorMessage("Schedule1") End Sub Sub FirstDaySort() On Error GoTo Catch Range("A1").CurrentRegion.Sort key1:=Range("J1"), Order1:=xlAscending, Header:=xlYes Catch: Call LogErrorMessage("FirstDaySort") End Sub Public Sub LogErrorMessage(ByVal funcName As String) Dim err_mess As String err_mess = err_mess & "番号: " & Err.Number err_mess = err_mess & " 詳細: " & Err.Description err_mess = err_mess & " 関数: " & funcName 'ログやメッセージを出力する Debug.Print (err_mess) Dim r As VbMsgBoxResult r = MsgBox(err_mess, vbOKOnly Or vbCritical) End Sub
以上、ご指導いただけませんか。よろしくお願いします。
この処理が動くとき、Sheets("データ一覧")のAutoFilerはどういう状態だという想定なのでしょうか。
そこが不確定だと、処理が思ったように動かないことにつながります。
処理の中で、一度AutoFilterを解除して改めて設定しなおす、とかやった方が確実かも。
特に複数のシートを扱う場合は、
Sheets("抽出").Select
Cells.Clear
のように事前にSelectする書き方よりは、
Sheets("抽出").Cells.Clear
のように直で書く、もしくはWithを使って
With Sheets("データ一覧")
.Range(.Range("A2"), .Cells(Rows.Count, 1).End(xlDown)).AutoFilter
End With
のように書くことをお勧めします。
jinojiさん、ありがとうございます。
Catch:の前にExit Subの記載で、Sortの処理が終了後のエラーメッセージは解決できました。ただ、「RangeクラスのAutoFilterメソッドが失敗しました」のエラーはこれでは消えませんでした。
[データ一覧]のデータをAutoFilerを使って日付列に入っている特定の日付[予定表で設定する]で絞り込んだ状態と想定しています。その結果を「抽出」シートにそのままコピーしたいと思っています。
書き方も大切なんですね。勉強になります。これからもいろいろ覚えていこうと思います。
ありがとうございました。助かりました。
Range("A1", Range("W1").End(xlDown)).SpecialCells(xlCellTypeVisible).Copy
でコピーする際に、範囲が意図通りになっているか気になります。
というのは、 End(xlDown)で最下行まで行ってしまい、
意図せず広大な範囲をコピーしているがために遅くなっているのでは、と考えたからです。
Debug.Print Range("A1", Range("W1").End(xlDown)).SpecialCells(xlCellTypeVisible).Address
とかで確かめてみてはどうでしょうか。
Jinojiさん、ありがとうございます。早速調べてみました。
結果：$A$1:$W$2,$A$5:$W$16,$A$2697:$W$1048576
この結果が何を意味しているのか、わからないのですが。すみません。
実際にコピーしたいデータがあるのはA1:W16だけです。
ここ[A1:W16]だけコピーしているつもりでしたが、間違っていたのでしょうか。
確かに時間がかかっていたのは、この部分でした。
どのように修正すれば実際にデータのある部分だけコピーペーストできるのでしょうか。
Filterの結果、W列が全て空白の行だけが表示されている状態と思われます。
その状態で Range("W1").End(xlDown) とやると、シート全体の最下行であるRange("$W$1048576")が選ばれることになります。
実際のシートのフォーマットがわからないのではっきりしたことは言いづらいですが、
Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
とかがよいような気がします。
jinojiさん、ありがとうございます。
早速書き換えてみました。
Debug.Printを設定して結果を見ると「True」と変わりました。そして、処理速度が劇的に速くなりました。
ただ、「RangeクラスのAutoFilterメソッドが失敗しました」のエラーメッセージは相変わらず消えません。
フォーマットというのは、どういう意味でしょうか？データの入力状態でしょうか？
[データ一覧]には、A列にはデータが必ず入力されており、A列がキーになっています。
他の列には、データがあったり、なかったりします。予約で日付が決まったものだけを日付列と時間列に入力し、特定の日付を指定してデータを絞り込んで抽出し、時間でソートをかけたいです。
Range(Range("A2"), Cells(Rows.Count, 1).End(xlDown)).AutoFilter
の行を消したらエラーが消える気がきます。
フォーマットといったのは、
シートの１行目が見出し行で２行目以降がデータ行、という形なのか、それとも見出し行はなくて１行目からデータ行なのか、とか
もし見出し行がある場合、コピーの際に見出し行も含めてコピーしたいのか、選択されたデータ行だけをコピーしたいのか、といったことです。
jinojiさん、ありがとうございます。
その記載の部分は教えていただいた通り、
With Sheets("データ一覧")
.Range(.Range("A2"), .Cells(Rows.Count, 1).End(xlDown)).AutoFilter
End With
に変更しています。
それでもまだ毎回ではなく、2回に1回は「RangeクラスのAutoFilterメソッドが失敗しました」のエラーが発生します。
フォーマットの解説ありがとうございます。
データ一覧のフォーマットは、シートの１行目が見出し行で２行目以降がデータ行になっております。
そして、コピー先には見出しも含めて「抽出」シートにコピーしたいです。
回答1件
0
ベストアンサー
多分こんな感じ。
VBA
1 Sheets("抽出").Cells.Clear 2 day1 = Sheets("予定表").Range("L2").Value 3 4 With Sheets("データ一覧") 5 '一旦フィルタを解除 6 .AutoFilterMode = False 7 'セットされた日付でオートフィルをかける(〇月〇日) 8 .Range("A1").AutoFilter field:=9, Criteria1:=Format(day1, "m月d日") 9 'オートフィルの結果をコピーする 10 .Range("W1", .Range("A1").End(xlDown)).SpecialCells(xlCellTypeVisible).Copy Sheets("抽出").Range("A1") 11 End With 12 13 14 '予約時間①でソートをかける 15 With Sheets("抽出") 16 .Range("A1").CurrentRegion.Sort key1:=.Range("J1"), Order1:=xlAscending, Header:=xlYes 17 End With 18
投稿2021/05/20 10:32
総合スコア4592
jinojiさん、ありがとうございます。
無事にエラーがなくなり、処理もとても速くなりました。
オートフィルの記述がよくなかったみたいですね。助かりました。もっとVBAのことを勉強していきます。
助かりました。ありがとうございました。
解決してよかったです。
エラーが２回に１回起きるからくりですが、
元のコードの
Range(Range("A2"), Cells(Rows.Count, 1).End(xlDown)).AutoFilter
Range("A1").AutoFilter field:=9, Criteria1:=Format(first, "m月d日")
が、
＜１回目＞
A2を見出しとしたフィルターを作る
→ （すでにフィルターがあるのに）A1を見出しとしたフィルターを作ろうとする →エラー
＜２回目＞
A2を見出しとしたフィルターを解除する
→ A1を見出しとしたフィルターを作ろうとする → OK
ということだと思います。
jinojiさん、詳しい説明ありがとうございます。なぜエラーが出ていたのかよくわかりました。
VBAをさわって4日目なので、WEBにあるコードをコピーして使用していました。
たくさん勉強しなければいけないですね。ありがとうございました。
あなたの回答
tips
プレビュー
