条件に一致する行を削除するマクロの書き方

質問

お世話になります。

EXCELのシート（添付参照ください）で受発注管理をしてます。
「No.」は（月2桁）（日2桁）（連番＝01～無限。これまでの最大は３桁）＋アルファベット（1文字以上）
で自動的に振られます。

ここから別ファイルをつくりたいのですが。

０）シートを新しいブックに「コピー」

１）「出荷数」に何らかの数字がある行を削除

２）「メモ」に特定の言葉（この表では”倉庫”）がある行を削除

３）作業日（この表では0912XXa＝9月12日）から１か月以前のデータの行を削除
　　（つまり8月13日以降のデータを残す）

４）表全体を選択して「No.」をキーにして並び替え

５）セルA1を選択

６）名前を付けて保存（形式は　「（特定の言葉）＋（西暦年4桁）（月2桁）（日2桁）＋データベース.xls）

これを一連のマクロで処理したいと考えております。
０、１、２、４、５、６は何とかなりそうなのですが、３）が私の技量ではできません。

１か月前ということは上に書きました通り、8/13～のみ残すということなのですが、
アタマに0813が付くデータはありません。この場合は0828～を残します。
２か月前でしたら同じく0713XXxのデータはありませんので、
0714～以降を残すことになります。

これはどうやって記述すればうまくいくでしょうか？

ご教示いただければ幸いです。

※すみません。再掲です。
　「何とかなりそう」と書いたのですが、ほかの部分も怪しいです。
　可能でしたら０～６すべて書いていただけると喜びます。

回答No.2

keithin · ベストアンサー

＞（４）を一旦外して実行しますと、
＞（３）で、実行時エラー13　型が一致しません

ということは、５行目６行目の他にもまだご相談で説明されてないナイショの部分がある事を示唆しています。
（３）の一体どこでエラーが出るのかも情報がありませんので、エラーの原因を推定する事も、対応を考えることもできません。ちなみにご相談で掲示された通りにサンプルデータを作成して確認していますが、エラーは再現しません。

５行目から始まるもそうですが、そういう部分は「教わればあとは自分で出来ると思って説明しなかった部分」なのですから、基本自力で解決してください。自力でマクロを修正できないなら、あなたのエクセルをご相談で例示されたのと全に仕上げてからマクロを使ってください。

それまでの「つなぎ」として、あてずっぽに対応を考えたマクロを掲示しておきますので、参考にしてください。

sub macro2()
　dim Target as range
　dim myDate as date
　dim s as string
　dim r as long

’「作業日」（９月１２日）のデータの行のセルを選択し、この日がそれだとエクセルに教える
　on error resume next
　set target = application.inputbox("Select TODAY's row", type:=8)
　if target is nothing then exit sub
　mydate = datevalue("2014/" & format(left(cells(target(1).row, "A").value, 4), "00/00"))
　mydate = dateadd("M", -1, mydate) + 1
　s = format(mydate, "mmdd")
　on error goto 0

’(0)
　activesheet.copy

’(1)
　range("F5:F" & range("F65536").end(xlup).row).autofilter field:=1, criteria1:="<>"
　activesheet.autofilter.range.offset(1).entirerow.delete shift:=xlshiftup
　activesheet.autofiltermode = false

’(2)
　range("H5:H" & range("H65536").end(xlup).row).autofilter field:=1, criteria1:="<>"
　activesheet.autofilter.range.offset(1).entirerow.delete shift:=xlshiftup
　activesheet.autofiltermode = false

’(4)
　range("A5:IV" & range("A65536").end(xlup).row).sort key1:=range("A5"), order1:=xlascending, header:=xlyes

’(3)
　for r = range("A65536").end(xlup).row to 6 step -1
　　if cells(r, "A")<s then
　　　rows("6:" & r).delete
　　　exit for
　　end if
　next r

’(5)
　range("A1").select

’(6)
　activeworkbook.saveas filename:="特定の言葉" & format(date, "yyyymmdd") & "データベース.xls"

end sub

お礼

再度の回答ありがとうございます。

実際のデータに当てはめて自分なりに書き換えてみましたが、
１か所だけエラーが出て進みません。
（(2)の部分で、実行時エラー1004
RangeクラスのAutoFilterメソッドが失敗）

ここから先は自分で頑張ってみようと思います。

お手数お掛けしました。

補足

おっしゃる通り、出していない情報があります
（具体的に言うと、もっとデータ列がありまして、
そこが空欄だったりします）。
こういう場で質問する自分も悪いのですが、
機密に該当するものもありますので…。

回答No.1

keithin

sub macro1()
　dim myDate as date
　dim s as string
　dim r as long

’(0)
　activesheet.copy

’(1)
　range("F:F").autofilter field:=1, criteria1:="<>"
　activesheet.autofilter.range.offset(1).entirerow.delete shift:=xlshiftup
　activesheet.autofiltermode = false

’(2)
　range("H:H").autofilter field:=1, criteria1:="<>"
　activesheet.autofilter.range.offset(1).entirerow.delete shift:=xlshiftup
　activesheet.autofiltermode = false

’(4)
　range("A1").currentregion.sort key1:=range("A1"), order1:=xlascending, header:=xlyes

’(3)
　mydate = datevalue("2014/" & format(left(range("A65536").end(xlup).value, 4),"00/00"))
　mydate = dateadd("M", -1, mydate) + 1
　s = format(mydate, "mmdd")

　for r = range("A65536").end(xlup).row to 2 step -1
　　if cells(r, "A")<s then
　　　rows("2:" & r).delete
　　　exit for
　　end if
　next r

’(5)
　range("A1").select

’(6)
　activeworkbook.saveas filename:="特定の言葉" & format(date, "yyyymmdd") & "データベース.xls"

end sub

お礼

ご回答ありがとうございます。
補足に情報を追加しましたのでそれを踏まえて
再度ご回答いただけないでしょうか。

補足

一度成功したかに見えたのですが、
二回目からエラーが出るようになってしまいました。

表でははしょってしまったのですが、実際は
５行目が見出し行で、６行目からデータが始まります。

エラーの内容としては、
（４）のところで、RangeクラスのSortメソッドが
失敗しました、と出ます。

（４）を一旦外して実行しますと、
（３）で、実行時エラー13　型が一致しません
となってしまいます。

再度ご回答いただけますと幸いです。