PR

【VBA】セルに書き込まれた（内容変更）時に処理を実行する

これで楽に！？VBA活用
2017.12.10
記事内に広告が含まれています。

こんにちは、Ryoです。
VBAでのコード実行にボタン等を使うことが多いのですが、用途によっては自動的に実行して欲しいこともありますよね。今回はセルの内容が変更された時（入力された時）に処理が実行されるChangeイベントについてサンプルを交えて書いていこうと思います。

サンプルとしては「対象列に特定文字が入力されたらメッセージ表示」、その応用として「特定文字が入力⇒対象行をコピー⇒別Sheetへ貼付け」の二つになります。

スポンサーリンク

1.サンプルその１

◆対象列に特定の文字が入力されたらメッセージボックスを表示

サンプル用として以下画像の表を準備しています。この判定欄に「NG」という文字が入力されたらメッセージボックスを表示するものです。

◆サンプルコード

Private Sub Worksheet_Change(ByVal Target As Range)

 '手動で範囲指定した際のエラー防止用
 If InStr(Target.Address, ":") <> 0 Then Exit Sub

 '引数Targetのアドレスに"B"が含まれ、且つ”NG"であれば処理
 '大文字/小文字/全角/半角を区別しない為のStrConvとLcase
 If InStr(Target.Address, "B") <> 0 _
 And StrConv(LCase(Target.Value), vbNarrow) = "ng" Then
    
     MsgBox "B列にNGが入力されました", vbInformation
  
  End If

End Sub

セルの内容が変更されたときに処理を行うにはChangeイベントを使用します。

Private Sub Worksheet_Change(ByVal Target As Range)

処理内容

End Sub

セルに対してなので当然ながら「シートモジュール」に記述します。
引数Targetはセルやセル範囲を表していますので、本サンプルではB列に入力された文字列をTarget.Valueで取得して「NG」かどうか判定しています。

その際に大文字や小文字、全角/半角で判定が変わると厄介なのでStrConvとLCaseで半角小文字に統一しています。他には範囲を指定するとエラーになるので、範囲選択した際の返り値に含まれる”：”を確認する処理も合わせて実施することで余計なエラーを防ぎます。

後はB列で且つ「NG」であればメッセージボックスを表示する処理をしています。
SelectionChangeイベントの記事でも書きましたが、便利なようでやや面倒ですよね（笑）

2.サンプルその２

使用する票はサンプル１と同じなのですが、「判定」欄に「NG」が入力されると、対象行をコピーして、別シート（サンプルでは”Sheet3”）「◆NG判定された品番一覧」の表に順次自動的に貼付けを実行するものです。

先程の表に上からNG⇒OK⇒NGを入力します。画面は固定化して処理するので変わりませんが、別Sheetにはこのように貼り付けられていきます。

◆サンプルコード

Private Sub Worksheet_Change(ByVal Target As Range)

 Dim ng_Row, ng_Column, Input_Row As Long
 Dim My_sht, ng_sht As Worksheet
 
 Application.ScreenUpdating = False
 
 'メイン側(入力用）Sheet
 Set My_sht = ActiveSheet
 'NG一覧表示用Sheet
 Set ng_sht = Sheets("Sheet3")

 '手動で範囲指定した際のエラー防止用
 If InStr(Target.Address, ":") <> 0 Then Exit Sub

 '引数Targetのアドレスに"B"が含まれ、且つ”NG"であれば処理
 '大文字/小文字/全角/半角を区別しない為のStrConvとLcase
 If InStr(Target.Address, "B") <> 0 _
 And StrConv(LCase(Target.Value), vbNarrow) = "ng" Then
   '行番号取得
   ng_Row = Target.Row
   '列番号取得
   ng_Column = Target.Column
   '対象範囲を選択しコピーする
   Range(Cells(ng_Row, ng_Column - 1), Cells(ng_Row, ng_Column + 3)).Copy
   'Sheet3の見出しにジャンプする
   Application.Goto Sheets("Sheet3").Cells(3, 1)
   'Sheet3のA列最終入力行を取得し+1することで入力対象行を把握
   Input_Row = ng_sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
   '対象セルに対し値のみ貼付けを実行
   ng_sht.Cells(Input_Row, 1).PasteSpecial Paste:=xlPasteValues, _
   Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   '入力用メイン側のSheetをアクティブ
   My_sht.Activate
   'カットコピーモードを解除
   Application.CutCopyMode = False
 End If
  
  Application.ScreenUpdating = True

End Sub

対象とするB列に「NG」が入力されたことを判定するまではサンプル１と同様ですが、その後の処理として「行／列番号」を取得しコピーしたい範囲を指定します。

ng_Row = Target.Row　’行番号取得
ng_Column = Target.Column　’列番号取得
‘対象範囲を選択しコピーする
Range(Cells(ng_Row, ng_Column – 1), Cells(ng_Row, ng_Column + 3)).Copy

次に貼り付けるSheet3の表見出しにジャンプし、そのSheet３の最終入力行を取得します。ここで大事なのは「Sheet3をアクティブにしているだけでは正確に取得しない」点ですね。
どういうことかと言いますと、コード内の記述は以下ですが、

Input_Row = ng_sht.Cells(Rows.Count, 1).End(xlUp).Row + 1

これをInput_Row = Cells(Rows.Count, 1).End(xlUp).Row + 1と記述してしまうと元の表がある実行Sheet側で処理されてしまうので、必ず処理対象のSheetを指定します。

後は対象セルに対して「値のみ貼り付ける」指定をして実行Sheetをアクティブにし、カットコピーモードを解除すればOKです。

‘対象セルに対し値のみ貼付けを実行
ng_sht.Cells(Input_Row, 1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
‘入力用メイン側のSheetをアクティブ
My_sht.Activate
‘カットコピーモードを解除
Application.CutCopyMode = False

これらのコードを記述することで、別Sheetに人知れずコピーされていきますから特定条件などで別に集計したい場合には参考になればと思います。

3.まとめ

今回取り上げたChangeイベントも何れ記事にしようと思っていたところ、関連する内容で問合せをいただいたこともあってサンプル交えて書いています。シートモジュールに記述することで自動的に処理できる反面、条件をきっちり指定しないと余計なエラーが出るので面倒な部分もありますが、用途によっては有効ですから機会があればご検討くださいませ！




以上、セルに書き込まれた（内容変更）時に処理を実行する方法についてでした！
今回の記事が何かの参考になれば幸いです。

Ryo

スポンサーリンク
タイトルとURLをコピーしました