[[20181213154414]] 『Changeイベント 複数』(初心者) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『Changeイベント 複数』(初心者)

Changeイベントを複数行いたいです。

今は、

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim i As Long, j As Long, k As Long
  Dim sn As String

  If Target.Column <> 4 Then Exit Sub
  If Target.Row < 5 Then Exit Sub
  i = Target.Column
  j = Target.Row
  k = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  If Cells(j, i - 1).Value <> "" Then Exit Sub
  Cells(j, i - 1).Value = "〇"

だけなのですが、追加で

 If Target.Column <> 7 Then Exit Sub

  If Target.Row < 5 Then Exit Sub
  i = Target.Column
  j = Target.Row
  k = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  If Cells(j, i).Value <> "" Then Exit Sub
  Cells(j, i).Interior.ColorIndex = 15 

と、まねて追加したのですができないです。

G列に入力されたらA〜G列を灰色にしたいのですが、続けて行って
いるのが原因なのでしょうか?

どんなことでもいいので教えてもらえないでしょうか?

< 使用 Excel:unknown、使用 OS:Windows7 >


抜け出す列数条件を7と4以外は抜け出しに。。。変えればどうでせう。
(隠居じーさん) 2018/12/13(木) 16:20

列数条件とはどういうものなのでしょうか?

検索しましたがありませんでした。

追加のコードだけで実行してみたのですが色がつかなかったです。

こちらに問題があるのでしょうか?
(初心者) 2018/12/13(木) 16:35


>>列数条件とはどういうものなのでしょうか?
Column のことです。

最後から2行目ですが。。。矛盾していませんでしょうか。=でいいような気がするのですが
勘違いでしたらお許しを ^^;。。。

If Cells(j, i).Value <> "" Then Exit Sub

(隠居じーさん) 2018/12/13(木) 16:40


Columnは既にあるけど これではいけないということなのですね?

最後から2行目に原因があるのですね?

ひとつ目のイベントは実行できたのですが、同じようにしたら
よくないということなのですね。

どのように直したらよいのでしょうか?
(初心者) 2018/12/13(木) 17:10


 kは何の為に求めているんですか?(使われてないように見えますが・・)

(半平太) 2018/12/13(木) 17:25


 こんな感じでしょうか、きっともっとスマートな方法が有るとは思いますが。^^
半平太さんもご案内の様にkは使っていないようですね。

 Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, j As Long
    i = Target.Column
    j = Target.Row
    If i = 4 Then
        If Cells(j, i - 1).Value <> "" Then Exit Sub
        Cells(j, i - 1).Value = "〇"
    ElseIf i = 7 Then
        i = Target.Column
        j = Target.Row
        If Cells(j, i).Value = "" Then Exit Sub
        Cells(j, i).Interior.ColorIndex = 15
    Else
        Exit Sub
    End If
End Sub
(隠居じーさん) 2018/12/13(木) 17:52

 すみません、あわてて余計な部分も残していました(下記に修正致します。) A^_^; 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, j As Long
    i = Target.Column
    j = Target.Row
    If i = 4 Then
        If Cells(j, i - 1).Value <> "" Then Exit Sub
        Cells(j, i - 1).Value = "〇"
    ElseIf i = 7 Then
        If Cells(j, i).Value = "" Then Exit Sub
        Cells(j, i).Interior.ColorIndex = 15
    Else
        Exit Sub
    End If
End Sub
(隠居じーさん) 2018/12/13(木) 18:01

最初に拝見してから見ない間に話が進んでますが、作っちゃったので投稿しておきます。
イベントでもブレークポイントを設定すれば【ステップ実行】をしてどのようにコードが実行されているのかを調べることができますから、一度ご自身で確認されることをお勧めします。

なぜ、実行されないのか理解できるとおもいますよ。

    Private Sub Worksheet_Change(ByVal Target As Range)

        Dim i As Long, j As Long, k As Long
        Dim sn As String

        Stop '←ココで一旦止まるから、ステップ実行して動きを追ってください

        If Target.Column <> 4 Then Exit Sub
        If Target.Row < 5 Then Exit Sub

        i = Target.Column
        j = Target.Row
        k = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row  '←要らないかも

        If Cells(j, i - 1).Value <> "" Then Exit Sub
        Cells(j, i - 1).Value = "〇"

        '-------追加分----------
        If Target.Column <> 7 Then Exit Sub
        If Target.Row < 5 Then Exit Sub
        i = Target.Column
        j = Target.Row
        k = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row  '←要らないかも
        If Cells(j, i).Value <> "" Then Exit Sub
        Cells(j, i).Interior.ColorIndex = 15

    End Sub

(もこな2) 2018/12/13(木) 18:25


 >>G列に入力されたらA〜G列を灰色にしたいのですが
でしたら
Range(Cells(j, i).Offset(, -6), Cells(j, i)).Interior.ColorIndex = 15
などで

(隠居じーさん) 2018/12/13(木) 19:09


G列に入力されたらA〜G列を灰色にしたいのですが Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Row < 5 Then Exit Sub
        Select Case .Column
            Case 4
                With .Offset(, -1)
                    If .Value <> "" Then Exit Sub
                    .Value = "〇"
                End With
            Case 7
                If .Value = "" Then Exit Sub
                Cells(.Row, "A").Resize(, 7).Interior.ColorIndex = 15
        End Select
    End With
End Sub

(ピンク) 2018/12/13(木) 19:32


Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Row < 5 Then Exit Sub
        Select Case .Column
            Case 4
                With .Offset(, -1)
                    If .Value <> "" Then Exit Sub
                    .Value = "〇"
                End With
            Case 7
                If .Value = "" Then Exit Sub
                Cells(.Row, "A").Resize(, 7).Interior.ColorIndex = 15
        End Select
    End With
End Sub

(ピンク) 2018/12/13(木) 19:33


 〇をセットする前に、イベントの連鎖を避けた方がいいような気がします。

 今回はあまり悪影響がないですけども・・

(半平太) 2018/12/13(木) 19:47


 If Target.Row < 5 Then Exit Sub
を抜かしていましたので。。。それと
半平太さんのご指摘内容の件だと思うのですが
何かTarget.Columnが4の時2回通っているような感じで
少し気になっていましたので修正致しました。

 Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, j As Long
    If Target.Row < 5 Then Exit Sub
    i = Target.Column
    j = Target.Row
    If i = 4 Then
        If Cells(j, i - 1).Value <> "" Then Exit Sub
        Application.EnableEvents = False
        Cells(j, i - 1).Value = "〇"
    ElseIf i = 7 Then
        If Cells(j, i).Value = "" Then Exit Sub
        Application.EnableEvents = False
        Range(Cells(j, i).Offset(, -6), Cells(j, i)).Interior.ColorIndex = 15
    Else
        Exit Sub
    End If
    Application.EnableEvents = True
End Sub
(隠居じーさん) 2018/12/13(木) 20:28

 反省。。。^^
iが7の時はセルの背景色を変えるだけなのでイベントは発生しないので
Application.EnableEvents = Falseは必要ないですね。
m(_ _)m
(隠居じーさん) 2018/12/13(木) 20:56

初心者です。
しばらく出張でこちらを拝見できてませんでした。

皆様、たくさんのご指摘ありがとうござます。

kは前任者(退職)が作成したので何の為かは分かりませんが、
別のエクセルでコントロール?b?自動入力する際に使用しているので、
消し忘れかもしれません。

影響がないようでしたら削除しておこうと思います。

**********************************************************

半平太様

>〇をセットする前に、イベントの連鎖を避けた方がいいような気がします。

良く理解できていないので調べてみます。
ありがとうございます。

*********************************************************

隠居じーさん様

Changeイベントを複数行う場合はIf〜ElseIfを使うものなのですね。
とても勉強になりました。
他にも行いたいことがありましたので応用してみようと思います。

ありがとうございます。

*********************************************************

もこな2様

>なぜ、実行されないのか理解できるとおもいますよ。

追加のコードには全然移動せず、頭に戻っていってました。
そもそも読まれていなかったので何も変化がおこなかったのですね。

とても勉強になりました。
次の機会にも試してみようと思います。
ありがとうございます。

*********************************************************

ピンク様

Changeイベントを複数行う場合はSelect Case .Columnを使うのですね。
隠居じーさん様と違う方法でも大丈夫とはびっくりです。

ただ、Case 4に追加しようとしたら何も実行されなかったです。
こちらはひとつの条件しかダメなのでしょうか。

調べてみます。
ありがとうございました。

(初心者) 2018/12/19(水) 11:35


>追加のコードには全然移動せず、頭に戻っていってました。
それは、D列に入力をおこなった場合ですよね。
今回は、G列に入力した場合でしょうから、そちらでテストしましょう。

ただ、例示も良くないですね。こちらに直してからテストしてください。

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim i As Long, j As Long

        Stop '←ココで一旦止まるから、ステップ実行して動きを追ってください

        If Target.Column <> 4 Then Exit Sub
        If Target.Row < 5 Then Exit Sub
        i = Target.Column
        j = Target.Row

        If Cells(j, i - 1).Value <> "" Then Exit Sub

        Application.EnableEvents = False
        Cells(j, i - 1).Value = "〇"
        Application.EnableEvents = True

        '-------追加分----------
        If Target.Column <> 7 Then Exit Sub
        If Target.Row < 5 Then Exit Sub
        i = Target.Column
        j = Target.Row

        If Cells(j, i).Value <> "" Then Exit Sub

        Application.EnableEvents = False
        Cells(j, i).Interior.ColorIndex = 15
        Application.EnableEvents = True

    End Sub

ちなみに直したところは、半平太さんが指摘されている、イベントの連鎖が発生するという部分です。

(もこな2) 2018/12/19(水) 12:31


追加で。

やってみると容易にわかるとおもいますが、
If Target.Column <> 4 Then Exit Sub
↑の部分で D列じゃなければ「Exit Sub」つまり、プログラム終了 としているので、実行されないのです。
なので、そちらの条件を、「D列じゃなければおわり」から「D列だったら処理」に変えないとダメです。

また、変更したセルが1つだけであれば、もとのコードを改造すれば問題ありませんが、本来、シート内の複数のセルを同時に変更することができますから、そういった操作をしたときのことも考えておく方がよいです。

ふまえるとこのような処理にすればよいでしょう

 マクロはじめ
  一時的にイベントを停止

    もし、変更したセルのうち、D5〜D1048576セルに含まれるものがあれば
        該当セルの、1つ左のセルを確認して、ブランクだったら、○を入力する。

    もし、変更したセルのうち、G5〜G1048576セルに含まれるものがあれば
        該当セルの、1つ左のセルを確認して、ブランクだったら、カラーインデックス15番の色で塗りつぶしを行う。

   イベント停止を解除
 マクロおわり

(もこな2) 2018/12/19(水) 13:16


もこな2様

ご指摘のとおりにG列に入力して実行してみました。

If Target.Column <> 4 Then Exit SubのExit Subで消えてしまいました。

Targetが4列目でない場合は終了となっていたのですね。

>「D列だったら処理」に変えないとダメです。

どこがダメだったのか分かりやすく教えていただきありがとうございます。
「D列だったら処理」の方法を調べてみます。

>セルを同時に変更することができます

半平太様のご指摘のイベントの連鎖といことでしょうか?
その為のApplication.EnableEvents = Falseなのですね。
勉強になりました。
ありがとうございます。

(初心者) 2018/12/19(水) 13:27


 >半平太様のご指摘のイベントの連鎖といことでしょうか? 
 >その為のApplication.EnableEvents = Falseなのですね。 

 イベントの連鎖がピンと来てないようですが、
 当時の私のコメントは、元々、回答案に対して発したものです。

 〇をセルにセットしたら、そこで新しいChangeイベントがまた発生してしまう。
 下手すると無限地獄になってエクセルは落ちます。(今回、それはないですが)

 なので、直前にイベントを発生しない処置をするのが無難と言うことです。
 セルへの入力が終わったら、FalseをTrueに戻すのも忘れない様に。

(半平太) 2018/12/19(水) 14:32


半平太様

ご丁寧な説明ありがとうございます。
やっと理解できました。

他のChangeイベントも確認し、修正しておきます。

(初心者) 2018/12/19(水) 15:14


値をクリアしたときのことも考えた方がいいんじゃないかな〜なんておもって付け加えていたらごちゃごちゃしちゃましたが、一例としてコードを提供します。
ステップ実行して、どの命令がなにをしているのか研究してみてください。

また、半平太さんがおっしゃるように今回は、マクロにより値を書き換える列が、D列ではないためイベントの無限連鎖は起きません。
が、余分な呼び出しをかける必要もないでしょうから、止めた方が無難に思います。

このほか、隠居じーさんさんがおっしゃるように、塗りつぶし色の変更をしても、Changeイベントが発動するわけではないので、そちらについてはイベント止める必要はないですが、いろいろ考えるのめんどくさいので、私は最初と最後に操作するようにしています。この辺は好みですかね・・・(他の回答者さんの意見も参考にしてください。)

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim MyRNG As Range

        Stop '←ブレークポイントのかわり

        'イベント停止
        Application.EnableEvents = False

        '【1つ目】
        'Targetのうち、D5〜D1048576セルに含まれるものがある場合だけ処理
        If Not Intersect(Target, Range("D5", Cells(Rows.Count, "D"))) Is Nothing Then

            ' Targetのうち、D5〜D1048576セルに含まれるセルを1つずつ処理
            For Each MyRNG In Intersect(Target, Range("D5", Cells(Rows.Count, "D")))

                If MyRNG.Value = "" Then
                    MyRNG.Offset(, -1).Value = ""
                Else
                    If MyRNG.Offset(, -1).Value = "" Then MyRNG.Offset(, -1).Value = "○"
                End If

            Next MyRNG
        End If

        '【2つ目】
        'Targetのうち、G5〜G1048576セルに含まれるものがある場合だけ処理
        If Not Intersect(Target, Range("G5", Cells(Rows.Count, "G"))) Is Nothing Then

            ' Targetのうち、G5〜G1048576セルに含まれるセルを1つずつ処理
            For Each MyRNG In Intersect(Target, Range("G5", Cells(Rows.Count, "G")))

                If MyRNG.Value = "" Then
                    MyRNG.Interior.Color = RGB(192, 192, 192)
                Else
                    MyRNG.Interior.ColorIndex = 0
                End If

            Next MyRNG

        End If

        'イベント再開
        Application.EnableEvents = True

    End Sub

(もこな2) 2018/12/19(水) 18:24


もこな2様

拝見してない間にご回答いただきありがとうございます。

そうなのです。
元に戻さないといかなかったのです!!

せっかく教えていただいたのですが下記のコードを少し変更したら動かなくなってしまいました。

(変更点)
G列に値がある場合 → A〜G列が灰色
無い場合 → オレンジ

どこが問題なのか教えていただけないでしょうか。
よろしくお願いします。

For Each MyRNG In Intersect(Target, Range("G5", Cells(Rows.Count, "G")))
If MyRNG.Value = "" Then
  MyRNG.Interior.Color = RGB(192, 192, 192)
Else

    MyRNG.Interior.ColorIndex = 0

        ↓
For Each MyRNG In Intersect(Target, Range(Cells("G5"), Offset(, -6), Cells(Rows.Count, "G")))
If MyRNG.Value = "" Then
  MyRNG.Interior.ColorIndex = RGB(205,204,204)
Else

    MyRNG.Interior.ColorIndex = RGB(192,192,192)

(初心者) 2018/12/21(金) 13:39


回答ではないですが、この掲示板の特徴として、文頭に半角スペースを入れるとおもったとおり
の形で投稿できると思います。

回答についてですが、↓の部分でエラーがでるようになっていませんか?いろいろミスっているので落ち着いて考えてみましょう

 For Each MyRNG In Intersect(Target, Range(Cells("G5"), Offset(, -6), Cells(Rows.Count, "G")))

とりあえず、理解度チェックです。
(1) 以下を正しく動くように修正してみましょう

 Cells("G5").Select

(2) 以下を「A5〜G5セル」が選択されるように修正してみましょう 

 Range(Cells(5,"G"), Cells(5,"G").Offset(, -6), Cells(Rows.Count, "G"))).Select

(もこな2) 2018/12/21(金) 15:48


もこな2様

ご指摘ありがとうございます。
急に半角になったりするので見づらかったですよね。
皆様どのように入力しているか気になってました。

>回答についてですが、↓の部分でエラーがでるようになっていませんか?

そのとおりです。
解答は下記で大丈夫でしょうか?

(1) Cells(5, "G").Select
(2) Range(Cells(5, "G"), Cells(5, "A")).Select
(初心者) 2018/12/21(金) 16:36


 もこな2さんではありませんが…大丈夫だと思います(^^)
 勉強のために見てたんですが、なかなかお返事がありませんね…(^^;

 それで、コードなんですが、勉強のために作ってみました。
 自分もVBAは勉強中の身ですので、おかしなところがあるかもしれませんが、参考になればということで
 載せておきます。

 Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim j As Long

    '変更されたセルがD列でもG列でもなければ処理を抜ける
    If Target.Column <> 4 And Target.Column <> 7 Then Exit Sub
    '変更されたセルが5行目よりも小さい行ならば処理を抜ける
    If Target.Row < 5 Then Exit Sub
    'jに変更されたセルの行数を代入
    j = Target.Row
    '変更されたセルがD列なら
    If Target.Column = 4 Then
        'C列j行目のセルに値があれば処理を抜ける
        If Cells(j, 3).Value <> "" Then Exit Sub
        'イベントの発生を抑止
        Application.EnableEvents = False
        'C列j行目のセルに"○"を入力
        Cells(j, 3).Value = "○"
        'イベントの発生の抑止を解除
        Application.EnableEvents = True
    '変更されたセルがD列でなければ(=G列なら)
    Else
        'G列j行目のセルに値があれば
        If Cells(j, 7).Value <> "" Then
            'A〜G列のj行目のセルをColorIndex=15で塗りつぶす
            Range(Cells(j, 1), Cells(j, 7)).Interior.ColorIndex = 15
        'G列j行目のセルに値がなければ
        Else
            'A〜G列のj行目のセルをColor=RGB(255,200,100)で塗りつぶす
            Range(Cells(j, 1), Cells(j, 7)).Interior.Color = RGB(255, 200, 100)
        End If
    End If

End Sub

(虎) 2018/12/25(火) 09:15


虎様

ありがとうございます。
修正しても動かなかったので困っておりました。

もう少し教えていただけないでしょうか。

虎様が教えていただいたコードでD列の値を消したらA〜C列の値を
消す場合、

  Application.EnableEvents = True
 Else
  Range(Cells(j, 1), Cells(j, 3)).ClearContents

  'G列j行目のセルに値があれば
   If Cells(j, 7).Value <> "" Then

としてみたのですが、今度は'C列j行目のセルに"○"を入力が
機能しなくなってしまいました。

どんなことでもよいので教えていただけないでしょうか。
よろしくお願いします。

(初心者) 2018/12/25(火) 10:50


 こういうことですかね?

 Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim j As Long

    If Target.Column <> 4 And Target.Column <> 7 Then Exit Sub
    If Target.Row < 5 Then Exit Sub
    j = Target.Row
    If Target.Column = 4 Then '※1
        '↓ここからコード変えました
        'D列j行目のセルに値がなければ
        If Cells(j, 4).Value = "" Then '※3
            Application.EnableEvents = False
            'A〜D列のj行目のセルの値をクリア
            Range(Cells(j, 1), Cells(j, 4)).ClearContents
            Application.EnableEvents = True
        Else '※4
            If Cells(j, 3).Value <> "" Then Exit Sub
            Application.EnableEvents = False
            Cells(j, 3).Value = "○"
            Application.EnableEvents = True
        End If
        '↑ここまでコード変えました
    Else '※2
        If Cells(j, 7).Value <> "" Then
            Range(Cells(j, 1), Cells(j, 7)).Interior.ColorIndex = 15
        Else
            Range(Cells(j, 1), Cells(j, 7)).Interior.Color = RGB(255, 200, 100)
        End If
    End If

End Sub

 とりあえずコード載せておきますので、動きを確認してみてください。

(虎) 2018/12/25(火) 11:46


ごめんなさい。どう説明したらわかりやすいかな〜なんて悩んでいたら投稿が遅くなっちゃいました。
虎さんの回答でもよいとおもいますけど、別アプローチを紹介しておきます。
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim MyRNG As Range       

        Stop '←ブレークポイントのかわり      

        'イベント停止
        Application.EnableEvents = False

        '【1つ目】
        'Targetのうち、D5〜D1048576セルに含まれるものがある場合だけ処理
        If Not Intersect(Target, Range("D5", Cells(Rows.Count, "D"))) Is Nothing Then

            ' Targetのうち、D5〜D1048576セルに含まれるセルを1つずつ処理
            For Each MyRNG In Intersect(Target, Range("D5", Cells(Rows.Count, "D")))
                If MyRNG.Value = "" Then
                    Cells(MyRNG.Row, "A").Resize(, 3).Value = "" '←(※注目)
                Else
                    If MyRNG.Offset(, -1).Value = "" Then MyRNG.Offset(, -1).Value = "○"
                End If
            Next MyRNG

        End If      

        '【2つ目】
        'Targetのうち、G5〜G1048576セルに含まれるものがある場合だけ処理
        If Not Intersect(Target, Range("G5", Cells(Rows.Count, "G"))) Is Nothing Then          

            ' Targetのうち、G5〜G1048576セルに含まれるセルを1つずつ処理
            For Each MyRNG In Intersect(Target, Range("G5", Cells(Rows.Count, "G")))
                With Intersect(Range("A:G"), MyRNG.EntireRow) '←(※注目)
                    If MyRNG.Value = "" Then
                        .Interior.Color = RGB(192, 192, 192)
                    Else
                        .Interior.ColorIndex = 0
                    End If

                End With

            Next MyRNG

        End If

        'イベント再開
        Application.EnableEvents = True

    End Sub

説明の続きは、もうちょっと整ってからにさせてください。

(もこな2) 2018/12/25(火) 12:55


虎様

>こういうことですかね?

そのとおりです。

最初にClearContentsを持ってくるのですね。
しかもEnd Ifで続けるのですね。

ありがとうございます。
とても勉強になりました。

※で順番を表記していただいたので とても分かりやすかったです。

(初心者) 2018/12/25(火) 13:07


 すみません… ※と番号はこっちのメモ的なものなんで忘れてください(^^;
 あとは、最初にClearContentsを持ってくるとかではなくて、Ifで条件により処理を分岐していて、
 If ○○ then までが条件になりますので、○○のところに注目して見ると、どんな条件で分岐しているのか
 わかるかと思います

 なんとなく、コードの理解があやふやなのかな?って感じがするので、きちんと理解したうえで使用していただいた
 方がいいかと思います… 自分はついさっきよくわからんままVBAを動かしてやらかしてしまったので…(^^;
(虎) 2018/12/25(火) 13:39

虎様

おかしな質問ばかりで申し訳ございません。

きちんと理解できるように少しづつ勉強していこうと思います。
ご丁寧にありがとうございました。

(初心者) 2018/12/25(火) 16:43


遅くなりました。【(初心者) 2018/12/21(金) 16:36】 のレスです。

(1) Cells(5, "G").Select
概ねそれでよいとおもいます。強いて言えば、列文字の「"G"」を使っている部分はそのようにすることもできるという話であって、基本は行番号、列番号ですから「Cells(5, 7).Select」のように考えておくとベターかなとおもいます。
その上で、"G5"のようにセル番地を使いたいのであれば、Cellsプロパティではなく、Rangeプロパティの方を使用するとよいでしょう。
【例】
Range("G5").Select

【参考】
https://sugoikaizen.com/excelvba/column_80/
https://excel-ubara.com/excel5/EXCEL813.html

(2) Range(Cells(5, "G"), Cells(5, "A")).Select
こちらは、間違いではありませんが、
「Range(Cells(5, "A"),Cells(5, "G")).Select」のように、より左上に近い方から書いた方がしっくり来るようにおもいます。
そして、注目すべきは、「範囲の始まり」となるセル、「範囲の終わり」となるセルの【2つ】が書かれているということです。


上記を踏まえて、
 Range(Cells("G5"), Offset(, -6), Cells(Rows.Count, "G"))

を見直してみましょう。
まず、セルを表しているっぽいものが、【Cells("G5")】【Offset(, -6)】【Cells(Rows.Count, "G")】のように3つ書かれてしまっています。セル範囲を表すには始まりと終わりの【2つ】ですから【3つ】あってはまずいのです。

つぎに、【Offset(, -6)】となっていますが、「何の」6列左なのか書かれていないのでここもエラーになります。

これがたとえば、

 Range(Cells(5,7).Offset(, -6), Cells(Rows.Count, "G"))
 Range(Range("G5").Offset(, -6), Cells(Rows.Count, "G"))

のようであれば、指定されているセル範囲は、「A5」から「G1048576」となり意味が通じ、この部分ではエラーは発生しなくなります。


ですが、
 Intersect(Target, Range(Range("A5"), Cells(Rows.Count, "G")))

↑をよく考えてみて下さい。
ここでされたいことは、G5〜G1048576のセル範囲に変化があったことを条件に処理したいのですよね?

ここで理解度チェックです。
(3)MyRNGには何がセットされるでしょうか?

 Set MyRNG = Intersect(Range("C10"), Range(Range("A5"), Cells(Rows.Count, "G")))

(4)MyRNGには何がセットされるでしょうか?

 Set MyRNG = Intersect(Range("C10"), Range(Range("G5"), Cells(Rows.Count, "G")))

(もこな2) 2018/12/26(水) 13:25


Changeイベントの無限連鎖のほうは、説明がちょっと難しいのですが、暇なときにでも新規ブックだけ開いた状態にして(半平太さんが懸念されているとおり、エクセルが落ちちゃう可能性もあるので)以下のコードをSheet1のモジュールに記述してみてください。
    Private Sub Worksheet_Change(ByVal Target As Range)
        Range("A1").Value = Range("A1").Value + 1
    End Sub

そして、記述したら、Sheet1のA1セルに1と入力してどうなるか確認してみてください。
無事に?実行時エラーになると「実行時エラー28 スタック領域が不足しています。」というエラーが表示されるとおもいます。(手元のExcel2007ではうまく再現できず)

>追加のコードには全然移動せず、頭に戻っていってました。
ステップ実行をしたときは分かりづらかったと思いますけど、実際には戻ってるわけではないんです。
上記のテストでいうと

 「A1」に入力(値の変更)
 ↑により、「Worksheet_Change」が開始され、「A1」の値が変更される
  ↑により、「Worksheet_Change」が開始され、「A1」の値が変更される
   ↑により、「Worksheet_Change」が開始され、「A1」の値が変更される
    ↑により、「Worksheet_Change」が開始され、「A1」の値が変更される
     ↑により、「Worksheet_Change」が開始され、「A1」の値が変更される
      ↑により、「Worksheet_Change」が開始され、「A1」の値が変更される

というように、自分自身を呼び出して無限に連鎖してしまってるんです。
(このように自分自身を呼び出す処理を再帰処理といいます。)

そして、再帰処理であれば、呼び出した処理が終われば呼び出し元に戻るのが原則です。
ですが、上記のように無限に呼び出さると子供の子供の子供の・・・・という関係を覚えておく部分がいっぱいになってしまい、Excel君が「もう覚えきれない!エラーにします」と反応するわけです。
【参考】
http://officetanaka.net/excel/vba/error/execution_error/error_28.htm

なお、テストではあえて+1にしましたが、同じ値に変えても(例えば1を1にかえたとしても)、Excel君は"値の変更"と見なし、「Worksheet_Change」がスタートしてしまいます。

なので、あらかじめイベントを止めるか、特定のセルに変化があったときだけ処理をするように設計する必要があるわけです。

(もこな2) 2018/12/26(水) 16:58


もこな2様

ご丁寧にありがとうございます。
遅くなって申し訳ございません。
理解するのに時間がかかってしまいました。

ご質問の件は下記で大丈夫でしょうか?

(3)MyRNGには何がセットされるでしょうか?

 Set MyRNG = Intersect(Range("C10"), Range(Range("A5"), Cells(Rows.Count, "G")))

 解答『C10』

(4)MyRNGには何がセットされるでしょうか?

 Set MyRNG = Intersect(Range("C10"), Range(Range("G5"), Cells(Rows.Count, "G")))

 解答 エラー(G5〜G1048576とC10は重ならないので)


それとChangeイベント試してみたのですがExcel2007では数字だとエラーは
出なくて、それ以外だと「型が一致しません」とエラーが出ました。
設定でエラーが出ないようになっているのかもしれません(謎)

教えていただいた参考サイトも分かりやすかったので今後の為にファイルしておこうと思います。

もこな2様のおかげで自分がどこが理解できていないのかがよくわかりました。
まだまだ勉強しないとですが頑張ります。

どうもありがとうございます。
感謝 感謝です。

(初心者) 2018/12/27(木) 13:41


(もこな2) 2018/12/26(水) 13:25 の続き & (初心者) 2018/12/27(木) 13:41のレス・・・・の前に、様を付けられるほど、偉くもないので、もし付けるなら"さん"でお願いします。

さて、(3)、(4)についてですが、いずれもIntersectメソッドが解らないと答えられませんから、もし確認されていなければこちらをご覧になってから考えてみてください。
http://officetanaka.net/excel/vba/tips/tips118.htm
https://www.moug.net/tech/exvba/0050074.html

↑を見て頂ければわかるかとおもいますが、
(3)は正解です。「C10」と「A5:G1048576」が重なるセルですから、【C10】セルとなります。

(4)は、「C10」と「G5:G1048576」が重なるセルとなり、もちろん存在しません。
ここまでの考え方はよいですが、Intersectメソッドは重なるものが無い場合、エラーではなく「Nothing」を返します。
なので、正解(セットされるもの)は【Nothing】になります。

踏まえて、もうお気づきだとおもいますが、コードを変更された部分では、G5〜G1048576のセル範囲で変化があったものだけ、MyRNGに取り出したいということになっていましたが、

 For Each MyRNG In Intersect(Target, Range("A5:G1048576"))

↑のようにしてしまうと、A5:F1048576と重なる部分まで対象になってしまうので、ここもマズいということになります。


ここで↓を整理しなおしてみましょう。
 「変更のあったセル」のうち「5行目以降」かつ「D列またはG列」のものがあれば「処理」

これは、裏を返せば

  「変更のあったセル」のうち「5行目以降」かつ「D列またはG列」のものが無ければ「処理せず終了」

となります。
特定のセル(範囲)が指定したセル範囲にあるかどうかを調べるには・・もうわかりますよね?

おさらいとして、以下のコードを適当なシート(ブック)を用意して、シートモジュールに貼り付けてから、マウスでB2〜I12まで選択して、1と入力してから、Ctrl+Enterで確定(値の一括入力)してみてください。

    Private Sub Worksheet_Change(ByVal Target As Range)

        If Intersect(Target, Rows("5:" & Rows.Count), Range("D:D,G:G")) Is Nothing Then Exit Sub

        MsgBox "処理対象セルは" & Intersect(Target, Rows("5:" & Rows.Count), Range("D:D,G:G")).Address(0, 0)

    End Sub

「処理対象セルは、D5:D12,G5:G12」と表示されれば成功です。
また、4行目より上の行にいくら入力しても何もおこらなければ、成功です。


上記のコードで4行目より上の行で入力しても何も起こらないのは
 If Intersect(Target, Rows("5:" & Rows.Count), Range("D:D,G:G")) Is Nothing Then Exit Sub

↑ここで「Nothing」が返っているため、「Exit Sub」しているからです。

ですから、私が提示したものは、条件を満たすときに処理する〜という書き方をしましたが、↓のような書き方もできます。

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim 処理範囲 As Range
        Dim MyRNG As Range

        Set 処理範囲 = Intersect(Target, Rows("5:" & Rows.Count), Range("D:D,G:G"))

        '条件にあうセルがTargetに含まれていなければ即終了
        If 処理範囲 Is Nothing Then Exit Sub

        '条件にあうセルを1つずつ処理
        For Each MyRNG In 処理範囲

            Select Case MyRNG.Column '←取り出したセルの列番号を取得

                Case Is = 4 '4列目(D列)だった場合
                    Application.EnableEvents = False
                    If MyRNG.Value = "" Then
                        Cells(MyRNG.Row, "A").Resize(, 3).Value = "" '←(※注目)
                    Else
                        If MyRNG.Offset(, -1).Value = "" Then MyRNG.Offset(, -1).Value = "○"
                    End If
                    Application.EnableEvents = True

                Case Is = 7 '7列目(G列)だった場合
                    With Intersect(Range("A:G"), MyRNG.EntireRow) '←(※注目)
                        If MyRNG.Value = "" Then
                            .Interior.Color = RGB(192, 192, 192)
                        Else
                            .Interior.ColorIndex = 0
                        End If
                    End With

            End Select

        Next MyRNG

    End Sub

次投稿へ、もう少しだけ続きます。

(もこな2) 2018/12/27(木) 22:53


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.