①E1セルにランダムなタイミングである数値が入力されます。
②E1に新しい数値が入力されたら、E5をスタートポイントとして順次E5,E6,E7。。。。と言うように、順次下の空白セルに自動的に入力するには、どのようにすれば良いのでしょうか?
なお、今回E列を使いましたが、列は任意の列で使用するものとします。
以上、宜しくお願い致します。
対象のシートに、以下のイベント処理をするコードを書いてください。
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 Application.EnableEvents = True End Sub
シートへのイベントの書き方は、ここが参考になるかと思います。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_event.html#change
対象のシートに、以下のイベント処理をするコードを書いてください。
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 Application.EnableEvents = True End Sub
シートへのイベントの書き方は、ここが参考になるかと思います。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_event.html#change
動作確認しました。
有り難うございましたm(_ _)m
シートのE1の値が変更されたらE5以下に順に並べるコード例です。
標準モジュールではなくシートモジュールに記述して使います。
監視セルと羅列開始位置はそれぞれE1とE5にしてあります。
Option Explicit Const iRangeFormula = "E1", sRangeFormula = "E5" Private Sub Worksheet_Change(ByVal Target As Range) ' 監視対象セル以外はExit If Intersect(Target, Range(iRangeFormula)) Is Nothing Then Exit Sub ' 変数準備 Dim iRange As Range, sRange As Range Set iRange = Range(iRangeFormula) Set sRange = Range(sRangeFormula) ' 書き込み Application.EnableEvents = False If IsEmpty(sRange) Then sRange.Value = iRange.Value Else Cells(Rows.Count, sRange.Row).End(xlUp).Offset(1, 0).Value = iRange.Value End If Application.EnableEvents = True End Sub
Rows.Count を使うと、Excel 2003 とか 2007 以降とか、気にしなくて良いんですね。
回答を頂きまして有り難うございました。
動作確認はしておりませんが、エクセルバージョン共通で使えるのは助かります。
後ほど、動作確認をしたいと思います。
動作確認しました。
2013/09/16 11:31:13有り難うございましたm(_ _)m