エクセルでの質問です。

過去にE1セルにデーターが入力された時に、そのデーターが逐次下方にコピーされていく方法について、教えて頂きました。

今回は、1行づつ下方にコピーされたデーターが何千行もたまったときに、「自動的に消去する」方法について教えて頂きたく質問します。

消去するデーターは、当日の「年月日+時刻」のファイル名で保存しておきたいと考えています。
保存のインターバルは、最下行の行数がA2セルに出るようにしてありますので、その数値が10,000(行数は任意の数値とする)に達したときに保存/消去したいと思います。
なお、消去するセルはA5~E65000です。(任意に設定可能希望)

時間的に言えば、保存・消去は10時間くらいおきになります。

以上、宜しくお願い致します。

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2013/11/13 14:45:19
  • 終了:2013/11/14 12:36:37

ベストアンサー

id:a-kuma3 No.1

a-kuma3回答回数4559ベストアンサー獲得回数19032013/11/13 16:23:46

ポイント800pt

http://q.hatena.ne.jp/1379290598 の続きだとして、シートの変更イベントの処理の最後の方に、以下のようなコードを追加します。
データを自動で追加している行の位置が、前回と同じで target_row という変数に入っていることを前提としています。


Private Sub Worksheet_Change(ByVal Target As Range)

    ...

    Application.EnableEvents = False

    ...

    ' ここから、今回追加するコード

    ' 書き込み先が 10000 以上になったら
    If target_row >= 10000 Then

        Const save_dir = "d:\"          ' 保存先のディレクトリ(¥で終わるように)
        Const save_range = "A5:E65000"  ' 保存対象の範囲
        
        ' 保存対象を切り取る
        Range(save_range).Select
        Selection.Cut
    
        ’新しいブックを作成して、シートに切り取ったデータを貼りつける
        Set newBook = Workbooks.Add
        newBook.ActiveSheet.Paste
    
        ' 日付+時刻のファイル名で保存
        filename = save_dir & Format(now, "yyyymmdd-HHMM") & ".xlsx"
        newBook.SaveAs Filename:=filename, FileFormat:=xlOpenXMLWorkbook
        newBook.Close
    
    End If

    ' ここまで

    Application.EnableEvents = True

End Sub
id:iwana1999

回答頂きまして有り難うございます。
早速、確認しまして明日に結果を報告致します。

2013/11/13 22:52:26

その他の回答(1件)

id:a-kuma3 No.1

a-kuma3回答回数4559ベストアンサー獲得回数19032013/11/13 16:23:46ここでベストアンサー

ポイント800pt

http://q.hatena.ne.jp/1379290598 の続きだとして、シートの変更イベントの処理の最後の方に、以下のようなコードを追加します。
データを自動で追加している行の位置が、前回と同じで target_row という変数に入っていることを前提としています。


Private Sub Worksheet_Change(ByVal Target As Range)

    ...

    Application.EnableEvents = False

    ...

    ' ここから、今回追加するコード

    ' 書き込み先が 10000 以上になったら
    If target_row >= 10000 Then

        Const save_dir = "d:\"          ' 保存先のディレクトリ(¥で終わるように)
        Const save_range = "A5:E65000"  ' 保存対象の範囲
        
        ' 保存対象を切り取る
        Range(save_range).Select
        Selection.Cut
    
        ’新しいブックを作成して、シートに切り取ったデータを貼りつける
        Set newBook = Workbooks.Add
        newBook.ActiveSheet.Paste
    
        ' 日付+時刻のファイル名で保存
        filename = save_dir & Format(now, "yyyymmdd-HHMM") & ".xlsx"
        newBook.SaveAs Filename:=filename, FileFormat:=xlOpenXMLWorkbook
        newBook.Close
    
    End If

    ' ここまで

    Application.EnableEvents = True

End Sub
id:iwana1999

回答頂きまして有り難うございます。
早速、確認しまして明日に結果を報告致します。

2013/11/13 22:52:26
id:taknt No.2

きゃづみぃ回答回数13539ベストアンサー獲得回数11982013/11/13 21:08:29

ポイント200pt

マクロ入りで保存する場合

Private Sub Worksheet_Change(ByVal Target As Range)
    Const= "E"
    Const 消去件数 = 10000
    Const 消去範囲 = "A5:E65000"
    
    Dim c As Long
    
    If Cells(1,).Address <> Target.Address Then Exit Sub
    c = 5
    Application.EnableEvents = False
    If Cells(5,).Value = "" Then
        c = 5
    Else
        If Cells(6,).Value = "" Then
            c = 6
        Else
            c = Cells(5,).End(xlDown).Row + 1
        End If
    End If
    Cells(c,) = Cells(1,)
    
    If c - 4 >= 消去件数 Then
        d = Format(Now, "yyyymmddhhmmss") & ".xls"
        ActiveSheet.Select
        ActiveSheet.Copy
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & d
        ActiveWorkbook.Close
        Range(消去範囲).Clear
    End If
    
    Application.EnableEvents = True


End Sub

id:iwana1999

回答を頂きまして有り難うございます。
以前のつながりがあるものですから、先に回答頂きました方のコードで確認中です。

2013/11/13 22:56:04
id:iwana1999

a-kuma3 様

お世話になります。
昨晩、10000行で保存・データー消去を試して見ました。
結果は保存ファイルのエラーがでて、保存できずにスクリプトは停止していました。

エラー画像を取得しているのですが、掲載方法が分かりませんので文章で説明させて頂きます。
------------------------------------------------------
Microsoft Visual Basic
実行時エラー '1004'
WorkbookクラスのSabeAsメソッドが失敗しました。
 
  終了  デバッグ  ヘルプ
--------------------------------------------------------

使用中スクリプトは次の通りです。

Private Sub Worksheet_Change(ByVal Target As Range)

Const Target_Column = 5 ' E列
Const Start_Row = 5 ' E5 を開始
Const Input_Row = 1 ' E1 を入力

' E1 かどうか確認
If Target.Row <> Input_Row Or Target.Column <> Target_Column Then Exit Sub


Application.EnableEvents = False


If IsEmpty(Cells(Start_Row, Target_Column)) Then
target_row = Start_Row
ElseIf IsEmpty(Cells(Start_Row + 1, Target_Column)) Then
target_row = Start_Row + 1
Else
target_row = ActiveSheet.Cells(5, Target_Column).End(xlDown).Row + 1
End If

Cells(target_row, Target_Column).Value = Cells(1, Target_Column).Value
Cells(target_row, 2).Value = Cells(1, 2).Value
Cells(target_row, 3).Value = Cells(1, 3).Value
Cells(target_row, 4).Value = Cells(1, 4).Value

If Cells(target_row, Target_Column).Value <> "" Then
Target.Offset(target_row - 1, -4).Value = Date + Time
' Target.Offset(Target_Row - 1, -3).Value = Time
End If

'----------------- 書き込み先が 10000 以上になったら --------------------------
If target_row >= 10000 Then

Const save_dir = "c:\" ' 保存先のディレクトリ(¥で終わるように)
Const save_range = "A5:E10000" ' 保存対象の範囲

' 保存対象を切り取る
Range(save_range).Select
Selection.Cut

'新しいブックを作成して、シートに切り取ったデータを貼りつける
Set newBook = Workbooks.Add
newBook.ActiveSheet.Paste

' 日付+時刻のファイル名で保存
Filename = save_dir & Format(Now, "yyyymmdd-HHMM") & ".xlsx"
newBook.SaveAs Filename:=Filename, FileFormat:=xlOpenXMLWorkbook
newBook.Close
End If

Application.EnableEvents = True

End Sub


保存しようとしたエクセルファイルは選択セルが青くなっていてデーターが消去されていました。
また、保存先ファイルは名前がbook1.xlsとなって、画面上に開いたままになっていました。


以上ですが、対処の方法をご教示頂けますと助かります。

  • id:windofjuly
    うぃんど 2013/11/13 15:08:11
    以前の質問は http://q.hatena.ne.jp/1379290598 ですね。

    10時間=36,000秒で10000回…。

    平均3.6秒に1回のペースで書き込まれるシステムだったら、
    ファイルアクセスにかかる時間だけでもデータ飛んだりしないのかなぁ…?

    どのような仕組みでE1に入力しているのか知りませんが、
    Excelシート上に保存するのをやめて、
    Excelからデータベースに書き込むことを考えたほうがいいと思います。

    本題とは違う話で、どこまでフォローできるかわかりませんし、
    また14秒遅れになるかもしれないというトラウマもあるので、
    今回もコメントだけで去ります…。
  • id:iwana1999
    コメントを頂きまして有り難うございます。

    エクセルを使用しておりますのはそれしか理解出来ないのが最大の理由です。
    出来れAccessを使用した方が良いのでしょうが、いまから覚える能力がありません(^_^;)

    データーはUWSCを使って取得してエクセルに入力し、時系列データーを使ってシグナル計算をしております。
    元データーの更新が1~2秒ですので今のところ、エクセルにデーターを入力して計算させてもデーターの抜けは無いようですが、エクセルに表示される計算スピードは80%~90%となっておりますので、そろそろ限界かなという感じです。

    とりあえず今のままで使用してみます。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません