iwana1999回答ポイントなし

エクセルマクロの問題でお願いします。

E1セルにデーターが自動記入されると、５行目から下にデーターが追加するようになっています。
任意の行（仮に１００行とします）まで書き込んだ以降は、常に最下行の１００行目にデーターが書き込まれて、其れより上のデーターは１行ずつ繰り上がり、古いデーターは消去される、様にマクロを修正したいのですが、どのようにすれば良いでしょうか？

マクロ
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
End If

Application.EnableEvents = True

End Sub

ログインして回答する

ベストアンサー

空腹おやじ2019/07/05 16:34:27

やりたいのは、こんな事でしょうか？

Private Sub Worksheet_Change(ByVal Target As Range)

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

    'ここで指定した行まで書き込む
    Const BOTTOM_ROW    As Long = 100

    Dim Target_Row  As Long

    ' 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(Start_Row, Target_Column).End(xlDown).Row + 1
    End If

    If Target_Row > BOTTOM_ROW Then
        '最下行より下になったら、先頭行を削除する
        Rows(Start_Row).Delete

        '書き込む行を最下行にする
        Target_Row = BOTTOM_ROW
    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
    End If

    Application.EnableEvents = True

End Sub

BOTTOM_ROWより下にデータがない前提で処理しています。
先頭行の削除ではなく、先頭データ（Range）を削除したい場合は適当に修正してください。

スター

1件のコメントを見る
iwana1999 2019/07/05 17:00:40

空腹親父　様

早速､稼働しましたが想定通りに動きました。
お手数をお掛けしまして済みません。
有り難うございました。

なお、今後とも宜しくお願い致します。

スター

エクセルマクロの問題でお願いします。

ベストアンサー

空腹おやじ2019/07/05 16:34:27

iwana1999 2019/07/05 17:00:40

その他の回答

この質問へのコメント

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

質問の情報

この質問のカテゴリ

この質問に含まれるキーワード

人気の質問

メニュー

PC版