質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.34%

  • VBA

    1907questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

VBA ワークシートイベント

解決済

回答 1

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 244

m1226

score 7

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
としましたが駄目でした。

よろしくお願いします。

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • ExcelVBAer

    2018/07/25 13:16

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

    キャンセル

回答 1

checkベストアンサー

+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文であれば第2条件は第1条件の裏返しですので、ElseIfではなくElseでも同等の動きをすると思います。

ループ処理について

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

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

例えば記載いただいたコードでは
・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の空いているセルに転記する
といった感じであってますでしょうか。

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


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

Private Sub Worksheet_Change(ByVal target As Range)

    'A列以外は監視対象外
    If target.Column > 1 Then Exit Sub

    '30で割った余りが1~3となる行のみ処理(つまり各グループの先頭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


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

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/07/25 15:30

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

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

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

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

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

    キャンセル

  • 2018/07/25 16:28

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

    キャンセル

  • 2018/07/25 21:37

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

    また、変更を行った際や、セルをクリアした際の仕様ですが、
    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 ()と記載すれば勝手に値を消してくれるのでしょうか。。
    無知ですみません。。

    キャンセル

  • 2018/07/25 22:19

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

    キャンセル

  • 2018/07/31 20:55 編集

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

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

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

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

    キャンセル

  • 2018/08/01 09:34

    >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イベントは発生していますので、消えないのはロジックの問題ということになります。

    まずはご確認ください。

    キャンセル

  • 2018/08/01 12:11

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

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

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

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

    キャンセル

  • 2018/08/01 13:20

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

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

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

    キャンセル

  • 2018/08/01 15:26

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

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

    キャンセル

  • 2018/08/01 17:06

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

    連結セルや複数セルを一度に変更して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
    ```
    のように判定すればできると思います。
    単一セルに対しても同じ記述で値が取得できますので、対象セルが単一か複数化で処理を分ける必要もありません。

    お試しください。

    キャンセル

  • 2018/08/07 14:02

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

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.34%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

同じタグがついた質問を見る

  • VBA

    1907questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。