入力規則への貼り付けを禁止する
ツイッターで以下の発言をしたのをきっかけに作成したマクロ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 ・・・新着記事一覧を見る
イータ縮小ラムダ(eta reduced lambda)|エクセル入門(2023-11-20)
PIVOTBY関数(縦軸と横軸でグループ化して集計)|エクセル入門(2023-11-19)
GROUPBY関数(縦軸でグループ化して集計)|エクセル入門(2023-11-18)
PY関数(Pythonコードをセル内で実行)|エクセル入門(2023-11-17)
画像「セルに配置」のVBAについて(365の新機能)|VBA技術解説(2023-11-13)
スピルのゴーストの範囲を選択するVBA|ツイッター出題回答 (2023-10-31)
エクセル試験3:月間の所定労働時間|エクセル練習問題(2023-10-04)
エクセル試験2:所得税の計算|エクセル練習問題(2023-10-04)
エクセル試験1:曜日別の平均客単価|エクセル練習問題(2023-10-04)
列全体を指定する時のRangeとColumnsの違い|ツイッター出題回答 (2023-09-24)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.繰り返し処理(For Next)|VBA入門
4.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
5.変数宣言のDimとデータ型|VBA入門
6.条件分岐(IF)|VBA入門
7.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
8.並べ替え(Sort)|VBA入門
9.マクロとは?VBAとは?VBAでできること|VBA入門
10.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
- ホーム
- マクロVBA応用編
- マクロVBA技術解説
- 入力規則への貼り付けを禁止する
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。