Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2013)
セル入力後マクロが自動に動くが入力間違いで空白に戻した場合の対応
投稿日時: 19/11/29 17:02:40
投稿者: ひっちん1

ご教示お願いします
ネットを参考に下記式を作り
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
If Not Intersect(Target, Range("K:K")) Is Nothing Then
Range("A1").Value = Target.Row
 
Call エンター
 
End If
End Sub
 
___________________________________________________________
Sub エンター()
    
   Set i = Range("A1")
    
   Range("A" & i).Value = WorksheetFunction.VLookup(Range("K" & i).Value, Range("リスト!$D$3:$F$300"), 3, Fales)
    
End Sub
で動かすとリストにあるものと一致した場合は問題なく動くのですが
Range("K" & i)セルに該当外を入れると黄色く反転します←該当するものが無いという意味と思います
そこでリセットを行いRange("K" & i)セルを空白にするとやはり黄色く反転しますので
下記のように変更を行い
Sub エンター()
   
   Set i = Range("A1")
   If Range("K" & i).Value = "" Then
      Range("K" & i).Value = ""
         Else
      Range("A" & i).Value = WorksheetFunction.VLookup(Range("K" & i).Value, Range("リスト!$D$3:$F$300"), 3, Fales)
       End If
    
End Sub
 
動かすとリストと一致すると問題は無いのですが
Range("K" & i)セルに該当外を入れると黄色く反転するのはわかりますが
またリセットを行いセルを空白にしてエンターをすると今度は
 
If Not Intersect(Target, Range("K:K")) Is Nothing Thenの部分が黄色く反転して強制終了?になり
Excelがダウンしてしまいます
 
リスト外の値を入れて黄色く反転するのは良いのですが
空白に戻した場合のエラーが出ないようにする方法をご教示お願いします。
 
 
 
 
 
 
 

回答
投稿日時: 19/11/29 19:28:44
投稿者: simple

詳細を見ていませんが、
まず Changeイベントプロシージャに特有の話があります。
そのプロシージャのなかで、セルの値を変更すると、
それがChangeイベントプロシージャを起動させ、
それが、またChangeイベントプロシージャを起動させ、
と、際限なくつづくことになります。
 
セルの変更をする場合には、
その直前で、イベント起動を抑止するために、

    Application.EnableEvents = False
とし、
その直後で、
    Application.EnableEvents = True
として、イベント起動を復活させる必要があります。
これで、無限回の繰り返しは避けられます。
 
まずは、この対応を行ってみて下さい。

回答
投稿日時: 19/11/29 21:12:50
投稿者: WinArrow
投稿者のウェブサイトに移動

基本的に間違っているコードが存在します。
> Set i = Range("A1")
データ型が宣言されていません。
 
↓のように変更してみましょう。
 
Private Sub Worksheet_Change(ByVal Target As Range)
   
    If Not Intersect(Target, Range("K:K")) Is Nothing Then
        Call エンター(i:=Target.Row)
    End If
 End Sub
   
Private Sub エンター(ByVal i As Long)
    If WorksheetFunction.CountIf(Range("リスト!$D$3:$F$300").Columns(1), Me.Range("K" & i).Value) > 0 Then
        Application.EnableEvents = False
        Me.Range("A" & i).Value = WorksheetFunction.VLookup(Me.Range("K" & i).Value, Range("リスト!$D$3:$F$300"), 3, Fales)
        Application.EnableEvents = True
    End If
 End Sub
 
気になるところは
シートモジュール内で、他シートを参照しても大丈夫か?という点です。
できれば、名前定義して、その名前を使う方が無難・・・

回答
投稿日時: 19/11/29 21:33:35
投稿者: WinArrow
投稿者のウェブサイトに移動

シートモジュール内で
他シートは参照できないようです。
 
以下のように変更してみてください
 
>WorksheetFunction.VLookup(Range("K" & i).Value, Range("リスト!$D$3:$F$300"), 3, Fales)
 
↑の赤字の部分
 
リストシートのD3:F300の範囲に名前定義しましょう →仮に「範囲」としましょう
 
WorksheetFunction.VLookup(Range("K" & i).Value, Thisworkbook.Names("範囲").ReferstoRange, 3, Fales)

回答
投稿日時: 19/11/30 00:04:38
投稿者: 半平太

1.WorksheetFunction.Vlookup関数は、エラーになると実行が止まるので
  Application.Vlookup関数を使った方がいいと思います。
 
2.「エンター」なんて1行で済むコードを別にする必要はないんじゃないですか?
 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long
    
    If Not Intersect(Target, Range("K:K")) Is Nothing Then
        With Application
            .EnableEvents = False
            
            i = Target.Row            
            Range("A1").Value = i
            
            If Range("K" & i).Value = "" Then
                Range("A" & i).Value = Empty
            Else
                Range("A" & i).Value = _
                .VLookup(Range("K" & i), .Range("リスト!$D$3:$F$300"), 3, False)
            End If
            
            .EnableEvents = True
        End With
    End If
End Sub

ドット「.」の前にはApplicationが省略されているので、留意してください。

投稿日時: 19/11/30 11:18:17
投稿者: ひっちん1

 simpleさん
 WinArrowさん
 半平太さん
 
色々とご教示頂き、皆様に感謝申し上げます
 
ネットを参考に見様見まねで作成していますので
不備がたくさん発生しますので、ご教示大変助かりました
 
>1行で済むコードを別にする必要はないんじゃないですか
のご教示大変助かりました。
 
ネットでは別に記載してあったため、分けて作成しなければならないと
思い込んでいました。
 
また、式の記載をしていただけたことで
>その直前で、イベント起動を抑止するために、 Application.EnableEvents = False
>その直後で、 Application.EnableEvents = Trueとして、イベント起動を復活させる必要
をご教示頂いた式の挿入場所もわかり大変助かりました。
 
皆様、ありがとうございました。
 
今後もご教示をお願い申し上げます。