VBA ワークシートイベント

Question

VBAのワークシートイベントを使用した値の転記を繰り返して行う、値をクリアした場合転記先の値もクリアする。

値の転記は、対象行に末尾から転記していく。対象行に値が入力されていたら、一つ上の行に転記する。

値の転記はうまく行えたが、繰り返し処理の方法が分からない。
またクリア処理が実行されない。

1グループ3項目の転記を10グループで同じように行いたいです。
A1セルからA3セルに入力されたら、20行目から18行目に転記する。

次のグループはA31セルからA33セルで、
50行目から48行目に入力する。
次のグループは30行ごとプラスされる。

'ワークシートモジュール
Private Sub Worksheet_Change(ByVal Target As Range)

Select case target.address

case$A$1
set target = range("A1")

If target.value<>"" then
Call  grp1_1
Endif

End Select
End Sub

'標準モジュール
sub grp1-1()

If range("A20")="" then

range("A20")= range("A1")
range("E20")=10
range("F20")="abc"
End If
End sub

クリア処理は、
ElseIf target.value="" then
としましたが駄目でした。

よろしくお願いします。

Comments

[ExcelVBAer]

コードは<code>ボタンで記載してください。

Answer 1

記載コードについて

質問のコードはVBAですよね？本当に動いた実績のあるコードでしょうか？
・VBAでは関数名にハイフン(-)は使用できません。転記ミス？
・Selectに対するCase文の条件記述が間違っている。Adressプロパティで分岐するなら"$A$1"のように文字列型で記述する
・Select/Ifに対するEnd Select/End Ifの記述がない。
・select target = range("A1")は何をしたい？代入？TargetがA1の場合に入る処理でTargetにA1をセットしなおしている？？

間違った情報を記載されていては正しい回答はなかなか得られません。
まずは正しい情報を記載しましょう。

クリア処理について

＞クリア処理は、
＞ElseIf target.value="" then
＞としましたが駄目でした。

とのことですが、例えば

If target.value<>"" then
    Call grp1_1
ElseIf target.value="" then
    'ここにクリア処理を記述
    Call grp_Clear()
End If

というような記述をされていればクリア処理(上記ではgrp_Clearという関数)が実行されるはずです。
ちなみにElseIfに続けて記述されているtarget.value=""の部分は代入ではなく条件式です。
target.valueに空文字をセットしているわけではないのですが、そこは大丈夫でしょうか？

なお上記のIf文であれば第２条件は第１条件の裏返しですので、ElseIfではなくElseでも同等の動きをすると思います。

ループ処理について

プログラムでループ処理というと、１つの処理を実行する中で、特定の処理を繰り返し行うようなものを言います。

今回行いたいループ処理とは、「どんなタイミング」で「どこからどこまでの範囲」でループを行いたいのかがよくわかりません。

例えば記載いただいたコードでは
・A1セルに値を入力したタイミングで
・A20、E20、F20に値をセットする
といった処理を行っています。

今回期待するループ処理とは
・A1に値をセットしたタイミングで、A1⇒A20、A2⇒A19、A3⇒A18・・・A10⇒A11の転記を行いたい？
・同様にA31に値をセットしたタイミングで、A31⇒A50、A32⇒A49、A33⇒A48の転記を行いたい？
・A2やA3が変更された時はどんな動作？

ここらへんがはっきりしないとアドバイスが難しいです。
追記・修正をお願いします。

（回答を受けて追記）

整理すると
・A1～A3のセルで値が入力されたタイミングで
・A20～A18の空いているセルに転記する
といった感じであってますでしょうか。

全てのセルに１回ずつしか値が入力されないのならよいのですが、Worksheet_Chagneイベントは値を変更するたびに発生しますので、A1⇒A2⇒A1(変更)としたときにA18まで転記してしまいそうですね。
ここらへんの仕様をどうするか、もう少し詰めた方がいいかもしれません。

---

とりあえず各セルには１回ずつしか入力されない前提で、簡単なサンプルを提供させていただきます。

Private Sub Worksheet_Change(ByVal target As Range)
    
    'A列以外は監視対象外
    If target.Column > 1 Then Exit Sub
    
    '30で割った余りが1～3となる行のみ処理（つまり各グループの先頭３行）
    If (target.Row Mod 30) >= 1 And (target.Row Mod 30) <= 3 Then
        If target.Value <> "" Then
            Call tenki(target)
        End If
    Else
        '対象外の行では何もしない
        Exit Sub
    End If
End Sub

Sub tenki(ByVal target As Range)

    Dim i As Integer
    Dim iRow_Fr As Integer
    Dim iRow_To As Integer
    Dim iRow_End As Integer
    
    '転記元行
    iRowFr = target.Row
    
    'グループ最終行
    iRowEnd = target.Row - (target.Row Mod 30) + 20
    
    
    '3行分のループ処理
    For i = 0 To 2
        '転記先の行番号
        iRowTo = iRowEnd - i
        
        If Cells(iRowTo, "A") = "" Then
            '転記先のA列が空なら転記
            Cells(iRowTo, "A") = Cells(iRowFr, "A")
            Cells(iRowTo, "E") = 10
            Cells(iRowTo, "F") = "abc"
            
            '転記で来たらループ終了
            Exit For
        End If
    Next
End Sub

同じセルに複数回入力したときとか、範囲クリアした時とか問題ありますが、とりあえずの参考までに。

Comments

[退会済みユーザー]

ご回答ありがとうございます。
また、コードの記載が誤っており分かりづらい内容となってしまい申し訳ありません。
実際に使用しているコードをそのまま持って来ることが出来ないので、情報を変え、再度こちらに簡略化したコードを記載してしまいました。

select target = range("A1")は
set targetの誤りです。

クリア処理についても教えて頂いた方法で試してみます。

ループ処理についてですが、
グループごとに処理は同じになるので、入力したセルの値を渡して、
cells(i,1)のように、まとめて記載出来ないかなと思いました。
A1、A2、A3を入力した場合の処理はそれぞれ若干異なります。
A1とA31が同様の動作、A2とA32が同様の動作となるようなイメージです。
またA1を入力せず、A2を入力した場合は、A20に転記していくといった形を想定しています。
A1からA3で最初に入力した値を対象行の最後の行であるA20に転記させたいです。
次に入力した値はA19に転記し、入力した値を最後の行から順番に転記していくイメージです。

分かりづらい説明となってしまい申し訳ありません。
よろしくお願いいたします。

[jawa]

A1～A3を入力した順にA20~A18に転記したい、ということでしょうか？
とりあえず上記の解釈で回答にアドバイスを追記させていただきましたのでご確認ください。

[退会済みユーザー]

はい、その通りでございます。
入力した順に転記したいという認識であってます。
また上記の要点も整理頂いた通りです。
サンプルまでいただき非常に助かりました。
本当にありがとうございます。
こちらで実施してみます。

また、変更を行った際や、セルをクリアした際の仕様ですが、
F列に入ってる値で対象を判定しようかと考えています。
grpx-1、-2、-3はグループは異なってもそれぞれ全て同じ値を転記する形になります。

grp1-1
F列: "sample"
grp1-2
F列: "date"
grp1-3
F列: "value"

grp2-1
F列: "sample"
grp2-2
F列: "date"
grp2-3
F列: "value"
※grp3以降も同様

ちなみにクリア処理なのですが、試しに実施してみたのですが、上手くいきませんでした。。別のプロシージャを作成するイメージで捉えてしまったのですが、Call grp_Clear ()と記載すれば勝手に値を消してくれるのでしょうか。。
無知ですみません。。

[jawa]

クリア処理についてはどのような処理をお考えかわかりませんが、プロシージャを作成するイメージであっています。
※回答内では便宜的にgrp1_1と似た名前ということでgrp_Clearと記載させていただきました。
A1~A3セルが空欄に変更された時に、作成したgrp_Clear関数が実行されるという流れです。

[退会済みユーザー]

こちらの式を実行してみました。

If target.Value = "" Then
Call tenki_clear(target)
End If

deleteボタンで値をクリアすると実行されず、セルの値を直接編集して値を消すか、deleteの後にF2を押すと処理が行われます。

deleteボタンを押しただけでも処理を行う事は可能なのでしょうか。

[jawa]

>deleteボタンで値をクリアすると実行されず
Deleteキーで値を消しても反応しないということでしょうか？（それともシート上にDeleteという名前のボタンを配置してマクロ登録されています？）

当方の環境(Windows7/Excel2010)ではDeleteキーで値を消した時もWorksheet_Changeイベントが動作するようです。…バージョンの違いでしょうか。

例えば問題の個所を切り分けるために、下記のような簡単な処理で確認してはいかがでしょうか？
```
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Value = "" Then
MsgBox Target.Address & " Cleared"
Else
MsgBox Target.Address & " Inputed"
End If

End Sub
```
これでメッセージ表示されないようならWorksheet_Changeイベントが発生していないということになります。
メッセージ表示されるようならWorksheet_Changeイベントは発生していますので、消えないのはロジックの問題ということになります。

まずはご確認ください。

[退会済みユーザー]

ご回答ありがとうございます。

失礼致しました。
Deleteキーで値を消しても反応しないということです。

メッセージ表示を確認してみました。
deleteキーの場合ですと、メッセージは出力されず、直接編集ですとclearメッセージが出力されました。
文字を入力した場合も、Inputメッセージは出力されました。
ロジックにおかしいところがあるということでしょうか。

度々申し訳ございません。

[jawa]

前回コメントに記載した、メッセージ表示するだけのシンプルな内容のWorksheet_Changeイベントを使った結果ですよね？
そうであればロジックの問題ではなく、deleteキーで消した時にWorksheet_Changeイベントが発生していないのだと思います。
イベントが発生していれば必ずどちらかのメッセージは表示されるはずですので。

私の環境ではDeleteキー押下でWorksheet_Changeイベントが発生し、Clearメッセージが表示されていますので、バージョンの違いとかでしょうか。
ネットで検索しても、DELETEキーでWorksheet_Changeイベントが発生しない、という記事や報告は見当たらないようです。。

試しに新しいExcelブックで、前回コメントに記載したメッセージ表示するだけのシンプルなWorksheet_Changeイベントを記述して動作させてみてはどうでしょうか？

[退会済みユーザー]

ご確認ありがとうございます。

新しいブックで実行したらdeleteキーでワークシートイベントが動作しました。
ちなみにターゲットのセルを結合していたのですが、結合を解いたらdeleteキーでも動作できました。
結合する場合は、書き方を変えた方がいいのでしょうか。

[jawa]

連結セルを対象にしていたのですね。そこには思い至りませんでした。

連結セルや複数セルを一度に変更してWorksheet_Changeイベントが発生した場合、Targetには複数のセルを指すRangeオブジェクトが格納されています。
複数セルを指すRangeオブジェクトからは、Valueプロパティで値を取得することができません。

このような場合は、代表となるセル(連結セルなら左上)から値を取得します。
代表セルはTarget(1)で取得できます。

今回の場合、
```
Private Sub Worksheet_Change(ByVal Target As Range)

If Target(1).Value = "" Then
MsgBox Target.Address & " Cleared"
Else
MsgBox Target.Address & " Inputed"
End If

End Sub
```
のように判定すればできると思います。
単一セルに対しても同じ記述で値が取得できますので、対象セルが単一か複数化で処理を分ける必要もありません。

お試しください。

[退会済みユーザー]

度々ありがとうございます。
無事、解決する事が出来ました。