入力規則への貼り付けを禁止する
ツイッターで以下の発言をしたのをきっかけに作成したマクロVBAです。
シートに入力規則のリストを設定しました。
VBAでそのデータを使ったら規則外のデータが入っていてエラーが出てしまいました。
そこでセルのデータをチェックすることになりました。
どんなVBAを書きますか?
とは言っても間違った入力は完全には無くならないので、
Range.Validation.Valueでチェックします。
こんな感じなら出来ないことは無いけど、実用としては微妙な感じだと思います。
入力規則への貼り付けを禁止するVBA
Option Explicit
Private pWsName As String
Private pValiCnt As String
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'最初の1回だけ、頻繁に動くと邪魔になる可能性もあるので
If pWsName <> Sh.Name Then
On Error Resume Next
pWsName = Sh.Name
pValiCnt = ""
pValiCnt = Cells.SpecialCells(xlCellTypeAllValidation).Address
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'イベント抑止
Application.EnableEvents = False
On Error Resume Next
Dim rngVali As Range
Set rngVali = Sh.Cells.SpecialCells(xlCellTypeAllValidation)
'事前に保存してある入力規則数とチェック
If rngVali.Address <> pValiCnt Then
MsgBox "貼り付けしちゃダメ！"
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
'もともと入力規則がない場合
'元々はあって0になった場合は上でエラー判定される。
If Err.Number <> 0 Then
Application.EnableEvents = True
Exit Sub
End If
'今回変更されたセル範囲の中で入力規則があるセルのみ
Set rngVali = Intersect(Target, rngVali)
If Err.Number <> 0 Or rngVali Is Nothing Then
Application.EnableEvents = True
Exit Sub
End If
'入力規則に反した値があるかをチェック
Dim rng As Range
For Each rng In rngVali
If Not rng.Validation.Value Then
MsgBox "違う値貼り付けダメ！"
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
Next
'イベント再開
Application.EnableEvents = True
End Sub
（アドレスではなく、.Countで件数を入れても良いと思います。）
Changeイベントで、入力規則が設定されているセルのアドレスが変更されていないかを確認します。
さらに、Validation.Valueで入力規則に反する値が入れられていないかを確認しています。
メッセージボックスを出したうえで、Application.Undoで元に戻しています。
予測外の動作が起こることも考えておく必要があると思います。
このようなイベントを入れることを考えるよりシート保護をした上で、
入力規則に反する値があるかどうかだけVBAでチェックするくらいが良いでしょう。
これらについては以下を参照してください。
同じテーマ「マクロVBA技術解説」の記事
アクティブシート以外のWindowを設定できるWorksheetView
LSetとユーザー定義型のコピー（100桁の足し算）
省略可能なVariant引数の参照不可をラップ関数で利用
ブックのいろいろな開き方（GetObject,参照設定,アドイン）
入力規則への貼り付けを禁止する
Select Caseでの短絡評価（ショートサーキット）の使い方
RangeオブジェクトのFor EachとAreasについて
画像が行列削除についてこない場合の対処
新関数SORTBYをVBAで利用するラップ関数を作成
LAMBDA以降の新関数はVBAで使えるか
数字（1～50）を丸付き数字に変換するVBA
新着記事NEW ・・・新着記事一覧を見る
新旧マスタの差異比較｜Power Query（M言語）入門(2023-02-28)
有効な最新単価の取得｜Power Query（M言語）入門(2023-02-26)
有効な最新単価の取得｜Power Query（M言語）入門(2023-02-21)
グルーブ内の最小・最大｜Power Query（M言語）入門(2023-02-17)
2つのテーブルのマージ｜Power Query（M言語）入門(2023-02-15)
「売上」が数値の行のみ取り込む｜Power Query（M言語）入門(2023-02-13)
A列のヘッダー名を変更する｜Power Query（M言語）入門(2023-02-11)
CSVのA列が日付の行だけを取り込む｜Power Query（M言語）入門(2023-02-10)
列数不定のCSVの取り込み｜Power Query（M言語）入門(2023-02-09)
別ブックの最終シートの取り込み｜Power Query（M言語）入門(2023-02-08)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.RangeとCellsの使い方｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.繰り返し処理（For Next)｜VBA入門
5.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
6.マクロって何？VBAって何？｜VBA入門
7.並べ替え（Sort）｜VBA入門
8.Excelショートカットキー一覧｜Excelリファレンス
9.エクセルVBAでのシート指定方法｜VBA技術解説
10.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門
- ホーム
- マクロVBA応用編
- マクロVBA技術解説
- 入力規則への貼り付けを禁止する
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。