マクロで不要な行を削除したい

質問

エクセル９７を使っています。

　日付　名前　品目　・・・　
１
２
３
・
・

といった表で、日付は2003/2/13という表示になっています。

そこで、今日以前（今日は含まない）の日付の行を削除してしまいたいのですが
どうすればいいでしょうか？

ちなみに、空白行を削除するのに、

Application.ScreenUpdating = False
On Error Resume Next
With Columns("E:F")
.SpecialCells(xlCellTypeConstants).EntireRow.Hidden >=TODAY()
.SpecialCells(xlCellTypeFormulas).EntireRow.Hidden >=TODAY()
.SpecialCells(xlCellTypeComments).EntireRow.Hidden >=TODAY()

.SpecialCells(xlCellTypeVisible).EntireRow.Delete
.EntireRow.Hidden = False
End With

このような記述を使っています。

「今日」というとＴＯＤＡＹ（）関数ですよね。
でも、関数ってマクロに組み込めるのでしょうか？
しかも「今日以前」という記述はどうすればいいのか？
など考えると、わけがわからなくなりました。

今日以前の行を削除するマクロを教えてください。

ちなみに、日付の行では、曜日を追記する関数を使っております。
条件書式も３パターン使い切っております。
よって、マクロで行いたいです。

宜しくお願いします。

回答No.2

tokuse · ベストアンサー

どうしても古い日付の行を削除したいところならば仕方ないですが、
「オートフィルタ」機能を使ってみるのは如何でしょうか？
表の内部にカーソル置いて、メニューから
「データ」－「オートフィルタ」－「フィルタ」
で適用されます。
印刷用には便利な機能かと思います。

どうしてもマクロで削除したいのであれば、
int(now())で今日の日付がでるので
if 指定セル < int(now()) then その行を消すコード
と記述すれば良いと思います。

補足

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

Application.ScreenUpdating = False
On Error Resume Next
With Columns("E:F")
.SpecialCells(xlCellTypeConstants).EntireRow.Hidden = True
.SpecialCells(xlCellTypeFormulas).EntireRow.Hidden = True
.SpecialCells(xlCellTypeComments).EntireRow.Hidden = True

.SpecialCells(xlCellTypeVisible).EntireRow.Delete
.EntireRow.Hidden = False
End With
Application.ScreenUpdating = True
Sheets("★進捗管理全て").Select
Range("A2").Select

これは、空白行を削除するマクロです。
これに、答えていただいた、if 指定セル < int(now()) then その行を消すコード
を加えると、どのようになるのでしょうか？

回答No.3

tokuse

No2のtokuseです。補足に対して回答します。

＊まずは訂正で、int(now())はDateでまかなえます。
int(now())でやる理由があるときも無くは無いですが、とりあえずは
日付は2003/02/18という記述で統一されているとすればDateで十分です。
（私は時刻も入る条件分岐などでint(now())を使っていました。）
SpecialCellsではセルの内容を今日の日付と比較することは出来ませんので、
仮にF列に日付が入っているとすると、下記のソースで今日の日付と一致する
セルの行番号が割り出せます。（まあ、GOTOを使ったべたなやり方ですね）

Sub test1()

Dim i As Integer
i = 1

start:

'無限ループを防ぐためのトラップ
If Cells(i, 6) = "" Then Exit Sub

'今日の日付と一致するときにはその行を表示
If Cells(i, 6) = Date Then MsgBox (i)

'今日の日付より前の場合は削除する
'ちなみに一行消したらiは同じ数でないとならないのでGoToする
If Cells(i, 6) < Date Then
Sheets("★進捗管理全て").Rows(i).Delete
GoTo start
End If

'iを増やして一行下のセルに移る
i = i + 1

'以下の記述で"start:"行に飛んでループする
GoTo start

End Sub

データの入っている状況により、上記のコードでは思うように動作しないことも
ありますが、概要は以上です。
簡素なコード例ですので、読み解いて理解いただければ幸いです。

回答No.1

imogasi

EntireRow.Hidden 、EntireRow.Delete を組み合わせて使ったことはないのですが、私はEntireRow.Deleteを使うことを避けています。私はプログラムで行番号を示す変数を使うことが多いですが、削除により、勘違いが多くなるのを経験しているからです。
（１）Ｓｈｅｅｔ２が空いていればそれを使い、空いてなければ、ワークシートを挿入する。一応Sheet1--->Sheet2
の形で作ります。
（２）今日の日付けだけを抜き出しました。
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
d = sh1.Range("a1").CurrentRegion.Rows.Count
' MsgBox d
' MsgBox Date
j = 1
For i = 1 To d
If sh1.Cells(i, "a") = Date Then
sh2.Cells(j, "a") = sh1.Cells(i, "a")
sh2.Cells(j, "b") = sh1.Cells(i, "b")
sh2.Cells(j, "c") = sh1.Cells(i, "c")
j = j + 1
End If
Next i
End Sub
sh2.Cells(j, "c") = sh1.Cells(i, "c")
の部分は項目の数（列数）だけ連ねてください。
Ｔｏｄａｙ（）はＤａｔｅのようです。
少数例でテスト済み。Sheet2のＡ列の書式は日付けにして
下さい。