Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

10082 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

▼

【23763】今日よりも過去の日付を削除する 経理課手形大量発行担当 05/4/3(日) 16:25

【23764】Re:今日よりも過去の日付を削除する IROC 05/4/3(日) 17:03

【23771】Re:今日よりも過去の日付を削除する ponpon 05/4/3(日) 21:31

【23774】Re:今日よりも過去の日付を削除する 経理課手形大量発行担当 05/4/3(日) 23:21

【23775】Re:今日よりも過去の日付を削除する ponpon 05/4/4(月) 0:08

【23805】Re:今日よりも過去の日付を削除する 経理課手形大量発行担当 05/4/4(月) 22:37

【23809】Re:今日よりも過去の日付を削除する ponpon 05/4/4(月) 22:59

【23810】Re:今日よりも過去の日付を削除する ウッシ 05/4/4(月) 23:09

【23815】Re:今日よりも過去の日付を削除する ponpon 05/4/4(月) 23:35

【23816】Re:今日よりも過去の日付を削除する ウッシ 05/4/4(月) 23:46

【23817】Re:今日よりも過去の日付を削除する ponpon 05/4/4(月) 23:57

【23811】Re:今日よりも過去の日付を削除する 経理課手形大量発行担当 05/4/4(月) 23:09

【23772】Re:今日よりも過去の日付を削除する ちゃっぴ 05/4/3(日) 23:00

【23777】Re:今日よりも過去の日付を削除する ponpon 05/4/4(月) 1:57

【23778】Re:今日よりも過去の日付を削除する ちゃっぴ 05/4/4(月) 2:21

【23779】Re:今日よりも過去の日付を削除する ちゃっぴ 05/4/4(月) 2:35

【23795】Re:今日よりも過去の日付を削除する ponpon 05/4/4(月) 18:20

【23786】Re:今日よりも過去の日付を削除する Kein 05/4/4(月) 12:33

【23808】Re:今日よりも過去の日付を削除する 経理課手形大量発行担当 05/4/4(月) 22:52

【23813】Re:今日よりも過去の日付を削除する Kein 05/4/4(月) 23:34


	【23763】今日よりも過去の日付を削除する

経理課手形大量発行担当 - 05/4/3(日) 16:25 -


	引用なし

	パスワード

Eの列に様々な日付が入っております（例：2010/3/31という形式で）。
もし、今日よりも過去の日付が存在したならば、その行を削除して上へ詰めたいとき、マクロはどうしたらよいでしょうか。
よろしくお願いします。


	【23764】Re:今日よりも過去の日付を削除する

IROC - 05/4/3(日) 17:03 -


	引用なし

	パスワード

オートフィルタで抽出して削除してはみては？


	【23771】Re:今日よりも過去の日付を削除する

ponpon - 05/4/3(日) 21:31 -


	引用なし

	パスワード

　▼経理課手形大量発行担当さん：
　ponponです。こんばんは。
オートフィルターを使ってやってみました。
一行目には、見出しが入っているものとし、データは２行目からとします。
また、sheetは、アクティブになっているものとします。

>Eの列に様々な日付が入っております（例：2010/3/31という形式で）。
>もし、今日よりも過去の日付が存在したならば、その行を削除して上へ詰めたいとき、マクロはどうしたらよいでしょうか。
>よろしくお願いします。

Sub test()
　　Dim FilterRng As Range
　　
　　Set FilterRng = Range("E1").CurrentRegion
　　　　’フィルターをかける範囲は、"E1"のCurrentRegionとします
　　With FilterRng
　　　　.AutoFilter field:=5, Criteria1:="<" & DateValue(Now)
　　　　’A列からデータがあるとするのでE列は５番目、今日より前
　　　　Application.DisplayAlerts = False
　　　　.SpecialCells(xlCellTypeVisible).Delete
　　　　Application.DisplayAlerts = True
　　End With
End Sub


	【23772】Re:今日よりも過去の日付を削除する

ちゃっぴ - 05/4/3(日) 23:00 -


	引用なし

	パスワード

>もし、今日よりも過去の日付が存在したならば、
>その行を削除して上へ詰めたいとき、マクロはどうしたらよいでしょうか。

Sortをうまく使いこなしましょう。

まず、空いている列(作業列)に現在の行番号を書いておきます。

次に日付順にSortします。
そうすれば、今日以前のDataが存在した場合、
一箇所に集まりますのでそれをごそっと削除。
(元の順番に戻す必要がないのであれば、
Clear, ClearContentsを使うほうがお勧めです。)

最後に作業列でSortして、元の並びに戻して、
作業列のDataを消去してやれば、完成です。

AutoFilterを使った場合、内部でやっていることは
Union使って行を連結させているわけなので、速度は遅いですよ。


	【23774】Re:今日よりも過去の日付を削除する

経理課手形大量発行担当 - 05/4/3(日) 23:21 -


	引用なし

	パスワード

▼ponpon さん：

返信ありがとうございます。
1行目に見出しが入っているとして、
ponponさんが作っていただいたので挑戦してみたのですが、見出しが消えてしまいます。
私のは、見出しが3行目に入っています。A1,A2にも値が入っており、これも消えてほしくないです。説明が足りなくて申し訳ありません。
ponponさんの作っていただいたので自分で加工に挑戦してみたのですがうまくできませんでした。初心者ですみません。どうしたらよいでしょうか？


	【23775】Re:今日よりも過去の日付を削除する

ponpon - 05/4/4(月) 0:08 -


	引用なし

	パスワード

ponponです。

Sub test()
　　Dim FilterRng As Range
　　
　　Set FilterRng = Range("E2").CurrentRegion
　　　　　　　　　　　↑
　　ここでフィルターをかける範囲を指定していますので、
　　Set FilterRng = Range("A3:終わりの右下セル番地")で指定してください。


	【23777】Re:今日よりも過去の日付を削除する

ponpon - 05/4/4(月) 1:57 -


	引用なし

	パスワード

ponponです。
考えてやってみました。無駄な部分があるとは思いますが。。。
test1もtest2も
一度では削除できず、２度３度目で、すべて削除されます。
理由がわかりません。なぜでしょう？
dataは、H列まで入っていて、E列に日付データがあります。

Sub test1()
　　Dim myRng As Range
　　Dim r As Range
　　
　　Set myRng = Range("E2", Cells(Rows.Count, 5))
　　For Each r In myRng
　　　If r.Value <> "" Then
　　　　If r.Value < DateValue(Now) Then
　　　　　 Application.DisplayAlerts = False
　　　　　 r.EntireRow.Delete
　　　　　 Application.DisplayAlerts = True
　　　　End If
　　　End If
　　Next

Sub test2()
　　Dim myRow As Long
　　Dim i As Long
　　Dim myRng As Range
　　Dim mydelRng As Range
　　Dim r As Range
　
　With ActiveSheet
　 Application.ScreenUpdating = False
　 myRow = .Cells(Rows.Count, 5).End(xlUp).Row
　 Set myRng = .Range("A1").CurrentRegion
　
　 For i = 1 To myRow
　　.Cells(i, 9).Value = i
　 Next
　
　 myRng.Sort key1:=.Range("E1")
　 Set mydelRng = .Range("E1", "E" & myRow)
　　　For Each r In mydelRng
　　　　　If r.Value < DateValue(Now) Then
　　　　　　 Application.DisplayAlerts = False
　　　　　　 r.EntireRow.Delete
　　　　　　 Application.DisplayAlerts = True
　　　　　End If
　　　Next
　 Set myRng = .Range("A1").CurrentRegion
　　　myRng.Sort key1:=.Range("I1")
　　　
　　　For i = 1 To myRow
　　　　.Cells(i, 9).Value = ""
　　　Next
　 Application.ScreenUpdating = True
　End With
End Sub


	【23778】Re:今日よりも過去の日付を削除する

ちゃっぴ - 05/4/4(月) 2:21 -


	引用なし

	パスワード

>考えてやってみました。無駄な部分があるとは思いますが。。。
>test1もtest2も
>一度では削除できず、２度３度目で、すべて削除されます。
>理由がわかりません。なぜでしょう？

【23731】Re:For Next と For Each文の関係　
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=23731;id=excel

でも書きましたが、Cell(Row, Column)はIndexで指定できますよね？
Indexで指定できるような Collection Object を For Each ～ Next Loop で
削除するとこのような現象が発生します。

というのは、For ～ Next Loop を Index で
昇順(加算)に回しているのと一緒だからです。

そういった場合、逆順(減算)でLoopを回してやることにより、
回避できますが、ところがどっこいRow, Columnの削除は
非常に処理が重いのです。

これに関しては、Row, ColumnにIndexがついていることからもわかるでしょう？
削除するとそれ以降のIndexを再構成しなくてはなりませんから･･･

なので、私はめったに削除・挿入は使いません。
たいていは、Clear, ClearContentsで事足りるはずです。

ちなみに私が意図したまとめて削除とは、Loop内で開始行と終了行を取得し、
Loop終了後に削除すると言う意味です。
連続した範囲の削除は、それほど時間がかかりません。
(分断された範囲とでTestして、処理時間を計測してみるとよいでしょう)
もっとも、速度を求めるなら配列を使いますし、
Sortした上でAutoFilterを使うのはありでしょう。

あと、この私の発言は、もともとのDataがばらばらに並んでいて、
削除するものが非常に多いことが前提です。

1行しか削除しない場合とか、すでにきれいに並んでいるDataでは
こっちのほうが遅くなる場合もあります。


	【23779】Re:今日よりも過去の日付を削除する

ちゃっぴ - 05/4/4(月) 2:35 -


	引用なし

	パスワード

> というのは、For ～ Next Loop を Index で
> 昇順(加算)に回しているのと一緒だからです。

これをStep実行してみてください。

Sub Test1()
　　Dim i As Long

　　For i = 10 to 100
　　　　Rows(i).Delete
　　Next i
End Sub

Sub Test2()
　　Dim i As Long

　　For i = 100 to 10 Step -1
　　　　Rows(i).Delete
　　Next i
End Sub

Sub Test3()
　　Rows(10).Resize(90).Delete
End Sub

原因が一目瞭然になるはずです。
ついでに処理時間を計測してみるとよいかも･･･


	【23786】Re:今日よりも過去の日付を削除する

Kein - 05/4/4(月) 12:33 -


	引用なし

	パスワード

Sub Test()
　 Dim LR As Long, LC As Long

　 LR = Range("E65536").End(xlUp).Row - 3
　 LC = Range("IV3").End(xlToLeft).Column + 1
　 Application.ScreenUpdating = False
　 Cells(3, LC).Value = "Check"
　 On Error GoTo ELine
　 With Cells(4, LC).Resize(LR)
　　　.Formula = "=IF($E4<TODAY(),""NO"",ROW())"
　　　.SpecialCells(3, 2).EntireRow.ClearContents
　 End With
　 On Error GoTo 0
　 Range(Cells(3, 1), Cells(3, LC)).Resize(LR) _
　 .Sort Key1:=Cells(3, LC), Order1:=xlAscending, _
　 Header:=xlYes, Orientation:=xlSortColumns
ELine:
　 Columns(LC).ClearContents
　 Application.ScreenUpdating = True
End Sub
　
で、どうかな ?　
　


	【23795】Re:今日よりも過去の日付を削除する

ponpon - 05/4/4(月) 18:20 -


	引用なし

	パスワード

▼ちゃっぴさん：
ponponです。こんばんは。

>ついでに処理時間を計測してみるとよいかも･･･

前にも乱数で処理時間の計測をしましたが、これで２回目です。
>
>Sub Test1()
　の結果　240ms
>
>Sub Test2()
　の結果　231ms
>
>Sub Test3()
　の結果　10ms

という結果でした。
全然速さが違います。また、一つ脱初心者です。（忘れなければ）

ちゃっぴさんありがとうございました。
経理課手形大量発行担当さん　横からいろいろすみませんでした。


	【23805】Re:今日よりも過去の日付を削除する

経理課手形大量発行担当 - 05/4/4(月) 22:37 -


	引用なし

	パスワード

ありがとうございます！
でも、まだA3からE3にある見出しが消えてしまいます。
A4からE29まで情報がはいっているとして、以下のように書いたのですが・・・。

Set FilterRng = Range("a3:e29")
　　With FilterRng
　　　　.AutoFilter field:=5, Criteria1:="<" & DateValue(Now)
　　　　Application.DisplayAlerts = False
　　　　 .SpecialCells(xlCellTypeVisible).Delete
　　　　Application.DisplayAlerts = True
End With


	【23808】Re:今日よりも過去の日付を削除する

経理課手形大量発行担当 - 05/4/4(月) 22:52 -


	引用なし

	パスワード

▼Kein さん：
返信ありがとうございます！こちらも試してみましたが、処理が速い感じがしますね。
ただ、過去の日付が存在したものは削除されたのですが、一番最後の行に入っているデータと、下から2行目に入っていたデータの間に空白行ができてしまいます。
それを解決するためにまた別にマクロを追加すればいいのですけどね。


	【23809】Re:今日よりも過去の日付を削除する

ponpon - 05/4/4(月) 22:59 -


	引用なし

	パスワード

ponponです。こんばんは。

一応これでできると思いますが、この下のレスを十分お読みください。

Sub Test()
　　Dim FilterRng As Range
　　
　　Set FilterRng = Range("A3:E29")
　　
　　
　　With FilterRng
　　　　.AutoFilter field:=5, Criteria1:="<" & DateValue(Now)
　　　　Application.DisplayAlerts = False
　　　　.Offset(1, 0).SpecialCells(xlCellTypeVisible).Delete
　　　　Application.DisplayAlerts = True
　　　　.AutoFilter
　　End With
End Sub


	【23810】Re:今日よりも過去の日付を削除する

ウッシ - 05/4/4(月) 23:09 -


	引用なし

	パスワード

こんばんは

データ範囲だけFilterRngにセットしておいて、こんな感じでも

Sub test1()
　　Dim FilterRng As Range
　　Set FilterRng = Range("A4:E29")
　　Application.ScreenUpdating = False
　　With FilterRng
　　　　.Cells(1)(0).AutoFilter field:=5, Criteria1:="<" & DateValue(Now)
　　　　Application.DisplayAlerts = False
　　　　.SpecialCells(xlCellTypeVisible).Delete
　　　　Application.DisplayAlerts = True
　　　　.Cells(1)(0).AutoFilter
　　End With
　　Application.ScreenUpdating = True
End Sub

計算式で処理する方がなんとなく好きですけど。


	【23811】Re:今日よりも過去の日付を削除する

経理課手形大量発行担当 - 05/4/4(月) 23:09 -


	引用なし

	パスワード

▼ponpon さん：

確かに、できました。完璧です！
回答してくださってありがとうございました。


	【23813】Re:今日よりも過去の日付を削除する

Kein - 05/4/4(月) 23:34 -


	引用なし

	パスワード

んー・・たぶん
>Range(Cells(3, 1), Cells(3, LC)).Resize(LR)
↓
Range(Cells(3, 1), Cells(3, LC)).Resize(LR + 1)

という修正が必要だったのでしょう。
あと数式を入れたままでソートなどすると、結果がおかしくなる可能性があるので、
計算の直後に値のみにしてしまう処理も組み込んでみます。

Sub Test()
　 Dim LR As Long, LC As Long

　 LR = Range("E65536").End(xlUp).Row - 3
　 LC = Range("IV3").End(xlToLeft).Column + 1
　 Application.ScreenUpdating = False
　 Cells(3, LC).Value = "Check"
　 On Error GoTo ELine
　 With Cells(4, LC).Resize(LR)
　　　.Formula = "=IF($E4<TODAY(),""NO"",ROW())"
　　 .Copy
　　 .PasteSpecial xlPasteValues　
　　　.SpecialCells(2, 2).EntireRow.ClearContents
　 End With
　 Application.CutCopyMode = False
　 On Error GoTo 0
　 Range(Cells(3, 1), Cells(3, LC)).Resize(LR + 1) _
　 .Sort Key1:=Cells(3, LC), Order1:=xlAscending, _
　 Header:=xlYes, Orientation:=xlSortColumns
ELine:
　 Columns(LC).ClearContents
　 Application.ScreenUpdating = True
End Sub


	【23815】Re:今日よりも過去の日付を削除する

ponpon - 05/4/4(月) 23:35 -


	引用なし

	パスワード

ponponです。こんばんは。

.Cells(1)(0)の書き方なのですが、
Cells(1)は、FilterRngの中の一番目（インデックス１？）のセルという意味は知っているのですが、
Cells(1)(0)の場合その一つ上を参照しているようですが、このような書き方もあるのですね。(0)の意味は？・・・・

>計算式で処理する方がなんとなく好きですけど。
とは、具体的にどのように、もしよろしければ教えて頂きたいのですが？


	【23816】Re:今日よりも過去の日付を削除する

ウッシ - 05/4/4(月) 23:46 -


	引用なし

	パスワード

こんばんは、ponpon さん

>.Cells(1)(0)の書き方なのですが、
>Cells(1)は、FilterRngの中の一番目（インデックス１？）のセルという意味は知っているのですが、
>Cells(1)(0)の場合その一つ上を参照しているようですが、このような書き方もあるのですね。(0)の意味は？・・・・
省略した不精な書き方です。m(__)m
.Cells(1, 1).Item(0, 1)
.Cells(0, 1)ではエラーになりますので、Itemを使いますです。

>>計算式で処理する方がなんとなく好きですけど。
>とは、具体的にどのように、もしよろしければ教えて頂きたいのですが？
Keinさんのレスがそうなんですけど、行削除は遅いのでクリアしてソートされてますよね。

自分も、行削除の場合は作業列に数式セットしてSpecialCellsで該当行を削除します。
あまり処理速度も気にしないのでクリアしてソートとかもしないでDeleteしちゃいます。
（遅いとクレーム付いたら直しますけど。）


	【23817】Re:今日よりも過去の日付を削除する

ponpon - 05/4/4(月) 23:57 -


	引用なし

	パスワード

▼ウッシさん：

>省略した不精な書き方です。m(__)m
>.Cells(1, 1).Item(0, 1)
>.Cells(0, 1)ではエラーになりますので、Itemを使いますです。
この省略形は、初めて知りました。

>Keinさんのレスがそうなんですけど、行削除は遅いのでクリアしてソートされてますよね。

ケインさんのコードを試してみて、ClearContentsした後ソートすることで、
行削除と同じになることを初めて知りました。
まだまだ勉強不足です。
ありがとうございました。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

10082 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free