Ｐａｇｅ 15 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼一定期間後にデータを自動で削除 茶宝 02/8/29(木) 17:03 ┗Re:一定期間後にデータを自動で削除 BOTTA 02/8/29(木) 20:45 ─────────────────────────────────────── ■題名 ： 一定期間後にデータを自動で削除 ■名前 ： 茶宝 ■日付 ： 02/8/29(木) 17:03 -------------------------------------------------------------------------
| こんにちは。よろしくお願いします。 以下のようなことは可能でしょうか？ １．データ表をもつブックを開くときに、 ２．システム日付から、３ヶ月前の日付（基準日）を取得し、 ３．登録日を探索して、基準日前に該当する登録日のうち、最新日付の行番号 （最終行）を取得、 ４．データ行の開始から最終までをカットして、 ５．バックアップブックを開いて、 ６．バックアップブックの最終行の下にカットした行を挿入。 ７．バックアップブックを保存終了して、 ８．元の作業用ブックに戻る。 つまり、登録日が現在の日付から3ヶ月経過している行のデータだけを、自動的にバック アップして、元データからは削除するようなマクロを作りたいのです。 データのイメージとしてはこんな感じです。 登録日 ID 趣味 血液型 家族構成 性別 ･･･ 8/9 1 ゲーム A 弟1人 男 ･･･ 10/21 2 読書 B 兄1人 女 ･･･ |
| 茶宝 さん、こんにちは 試してみてください。 Sub aaa() 'Open時、自動でやるなら 'Private Sub Workbook_Open() 'に変えてThisWorkbookモジュールに貼り付けて下さい。 Dim D3Mago As Date Dim wb01 As Workbook, wb02 As Workbook Dim LastRow01 As Long, LastRow02 As Long Dim rr As Long, r01 As Range '3ヶ月前の日付を取得 D3Mago = DateAdd("m", -3, Date) 'xl2000限定 Set wb01 = ThisWorkbook 'バックアップBOOKは同一フォルダ内にありファイル名は"Bup.xls"として Set wb02 = Workbooks.Open(ThisWorkbook.Path & "\Bup.xls") 'どちらのシートもBOOK内の一番左にあるものとして､ LastRow01 = wb01.Worksheets(1).Range("A65536").End(xlUp).Row LastRow02 = wb02.Worksheets(1).Range("A65536").End(xlUp).Row wb01.Worksheets(1).Activate Set r01 = wb01.Worksheets(1).Range("A" & LastRow01 + 1) For rr = LastRow01 To 2 Step -1 If Range("A" & rr).Value < D3Mago Then Set r01 = Union(r01, Range("A" & rr)) End If Next 'コピーして r01.EntireRow.Copy wb02.Worksheets(1).Range("A" & LastRow02 + 1) '削除 r01.EntireRow.Delete '保存して閉じる wb02.Close True Set r01 = Nothing: Set wb01 = Nothing: Set wb02 = Nothing End Sub |