[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『チェンジイベントでのシート保護について』（TTC）
いつもお世話になっております。 今、過去ログ等を参考にさせていただきながら作っているのですが 分からないことがあり質問させていただきます。
やりたいことは、VLookup と 入力規則 の組み合わせなのですが、 数式を入れずチェンジイベントで行ないます。
A列に店コードを入力するとB列に並び順の番号、C列に店名 を表示 させます。D列はダブルクリックで入力リストを表示させます。
他は変更できないように入力する範囲以外は保護をかけます。
保護がかかっているのでコードに保護解除を記入したのですが 以下のところで「実行時エラー」アプリケーション定義または オブジェクト定義のエラーです。と出ます。
UnProtectとProtectを入れない状態では問題なく作動するのですが 挿入場所がいけないのでしょうか？ いろいろ試しましたがどうもうまくいきません どなたかアドバイスをください。お願いいたします。
以下、コード表示
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range)
'宣言 ########## Dim DWs As Worksheet, NWs As Worksheet Dim データ As Variant
'設定 ##########
Set DWs = ThisWorkbook.Sheets("データ")
Set NWs = ThisWorkbook.Sheets("入力")
With DWs
データ = .Range("A2:C62").Value 'VLookupの照合範囲
End With
'On Error GoTo エラー '店舗コード入力間違いの際の飛び先
With Target
If .Count > 1 Then Exit Sub '２以上のセルは無効
If .Row <= 5 Then Exit Sub '５行目までは見出し等なので無効
If .Column >= 5 Then Exit Sub '５列目より右は無効
NWs.Unprotect 'シート保護解除
If .Column = 1 Then 'Ａ列だったら
If .Value <> "" Then '空白じゃなかったら"順"と"店舗名"を記入
.Offset(0, 1).Value = Application.WorksheetFunction.VLookup(Target, データ, 2, False)
.Offset(0, 2).Value = Application.WorksheetFunction.VLookup(Target, データ, 3, False)
↑デバックするとここでとまっています（空白以外のとき）
End If
If .Value = "" Then '空白だったら(消したら)右のデータも空白にする
.Offset(0, 1).Value = ""
.Offset(0, 2).Value = ""
↑空白のときはここです
End If
End If
If .Column = 4 Then 'Ｄ列だったら入力規則を解除
With Target.Validation
.Delete
End With
End If
End With
NWs.Protect 'シート保護
Set DWs = Nothing '変数の開放 Set NWs = Nothing
Exit Sub
エラー:
MsgBox "そのコードの店舗はありません！" _
& vbCrLf & vbCrLf & _
"モ・ウ・イ・チ・ド 店舗コードを確認してください...", _
vbExclamation + vbOKOnly + vbDefaultButton1, "コードエラー！"
Target.Activate
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ActiveSheet.Unprotect 'シート保護解除
Cancel = True
With Target
If .Count > 1 Then Exit Sub '２以上のセルは無効
If .Row <= 5 Then Exit Sub '５行目までは見出し等なので無効
If .Column <> 4 Then Exit Sub 'Ｄ列以外は無効
With Target.Validation '入力規則でリストを設定する
.Delete
.Add Type:=xlValidateList, Formula1:="○,×,△"
.ShowError = False
End With
End With
ActiveSheet.Protect 'シート保護
End Sub
PS.ここにコードをコピー&ペーストしたあと、先頭に１行１行空白をいれてます
なにか他によい方法がありますか？（インデントみたいな...）
> なにか他によい方法がありますか？（インデントみたいな...） 取りあえずここだけ反応。 VBAのエディタ上で全選択してからTAB押すと頭に4桁の空白はいるはず。 これを使うか、1文字だけ入れたいなら矩形範囲でテキストをいじれるエディタを使うとか。 ここのリンクで紹介されている サクラエディタ http://members.at.infoseek.co.jp/sakura_editor/snapshot.html なら全選択後にスペース叩くと全行の頭にスペースが入ります。 なんて便利。 それだけ。 （ご近所PG）質問に対する回答ではない罠
私も書き方だけ・・・(^_^A; コード内の空白行をなくしておけば、最初の行だけ半角スペースを入れるだけで 全部が整形されます。(^_^A; （川野鮎太郎）
ざっと見ただけで検証してませんが問題ありそうなのは
変数「データ」がVariant型なのと
With DWs
データ = .Range("A2:C62").Value 'VLookupの照合範囲
End With
この部分。検索範囲はセル参照でなければいけないはず。
Range型で宣言して
With DWs
Set データ = .Range("A2:C62") 'VLookupの照合範囲
End With
にしてみては？
（みやほりん）
衝突しました！
ご近所PGさん、川野さん、ありがとうございました！ 「さくら」まだよく分かりませんがすごいですね！ あやうく没頭しそうになってしまいました... ちなみにこの文章もさくらです！！ （最初全角空白をいれてて悪戦苦闘...）
今度からここにノセル？のを前提に一文字開けとくのも 手ですね...？
ありがとうございました。（書き方について）
みやほりんさん、ありがとうございます。 さっそく試してみます。
(TTC)
ああ、試さなくてもいいです。 Variant型とRange型の区別はないみたいですね。 Vlookupはどちらでも動作するようです。 やはり検証してみないとだめでし。 （みやほりん）
試してしまいました... >Variant型とRange型の区別はないみたいですね。 どちらでもようということでしょうか？ 基本的にはRange型の方がよいのでしょうか？
(TTC)
いや、わたしがRange型で習慣的にやっていたというだけです。 原因は大体わかりました。 コード中でシートにデータを入力する前に Application.EnableEvents = False を挿入、Exit Subの前に Application.EnableEvents = True 念のためTarget.Activateのあとにも Application.EnableEvents = True を入れてみてください。イベントが交錯しているみたいです。 （みやほりん）
ありがとうございます。 Application.EnableEvents = False を挿入したら問題なく作動しました。 シート保護が原因ではなかったのですね？ データが入力されたときにまたイベントが発生してしまう ということでしょうか。
シート保護かけなかったときにうまくいくのはなぜでしょう？ スイマセン解決したのですが...
(TTC)
順を追いますと、 イベント１発生 →保護解除 →先のVlookupでイベント２発生→イベント２内でシート保護 →イベント１へ復帰 →あとのVlookupでシートが保護されてしまっているので書き込みできない ということだと思います。 Changeイベント内でシートのデータ変更は連鎖的にChangeイベントが 発生してしまうので、イベントの抑制が必要。わたしもうっかりしてましたね。 （みやほりん）
とても分かりやすいご説明ありがとうございました。 If .Column = 2 Then Exit Sub '２列目より右は無効 を入れても大丈夫ということですよね...！
ありがとうございました！
(TTC)
Application.EnableEvents = False の前にExit Subなら問題ないと思います。 （みやほりん）
みやほりんさん、ありがとうございました。
もうひとつ、質問させていただいてよろしいでしょうか？ 同じ内容が過去ログにあったのですが、応用力がなくヒントだけでも いただきたいのですが... If .Count > 1 Then Exit Sub '２以上のセルは無効 のところ、例えば同じコードが続く場合、オートフィルしたとき まとめてDeleteした時などに対応するには？という質問です。 できますでしょうか？
(TTC)
確認です。 （１）オートフィルしたときにもVlookupで検索を成立させたい。 （２）A列DeleteしたときはB列C列もクリアしたい、ってことでしょうか。 （みやほりん）
はい。（１）・（２）共にその通りが希望です。 (TTC)
腹案はありますが、ただいま帰り支度中。 寝るまでにやってみますが、 「さくっ」と行かないかもしれないので時間がかかるカモ、です。 それでよろしければ。 （みやほりん）
下からお邪魔します。
よくみたら、σ(^◇^;)のコードに似てるのがあったので
うれしくなってちょっと考えてみました。
たぶん、こんな感じじゃないかと思うけど、、駄目だったら(・_・ )ノ" ゜ ポイッ
してください。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'宣言 ##########
Dim DWs As Worksheet, NWs As Worksheet
Dim データ As Variant, x As Variant, C As Range
'設定 ##########
Set DWs = ThisWorkbook.Sheets("データ")
Set NWs = ThisWorkbook.Sheets("入力")
With Target
If .Row <= 5 Then Exit Sub '５行目までは見出し等なので無効
If .Column >= 5 Then Exit Sub '５列目より右は無効
End With
データ = DWs.Range("A2:C62").Value 'VLookupの照合範囲
Application.EnableEvents = False
Me.Protect , , , , True
With Target
Select Case .Column
Case 1 'Ａ列だったら
If .Count > 1 Then
For Each C In Selection
If Not IsEmpty(C.Value) Then '空白じゃなかったら"順"と"店舗名"を記入
'店舗コードがあるか調べて
x = Application.Match(C.Value, DWs.Range("A2:A62"), 0)
'あったら
If Not IsError(x) Then
C.Offset(0, 1).Value = Application.WorksheetFunction.VLookup(C.Value, データ, 2, False)
C.Offset(0, 2).Value = Application.WorksheetFunction.VLookup(C.Value, データ, 3, False)
' ↑デバックするとここでとまっています (空白以外のとき)
Else 'なかったら
MsgBox C.Value & " の店舗はありません！" _
& vbCrLf & vbCrLf & _
"モ・ウ・イ・チ・ド 店舗コードを確認してください...", _
vbExclamation + vbOKOnly + vbDefaultButton1, "コードエラー！"
End If
Else '空白だったら(消したら)右のデータも空白にする
.Offset(0, 1).Value = ""
.Offset(0, 2).Value = ""
' ↑空白のときはここです
End If
Next
Else
If Not IsEmpty(.Value) Then '空白じゃなかったら"順"と"店舗名"を記入
'店舗コードがあるか調べて
x = Application.Match(.Value, DWs.Range("A2:A62"), 0)
'あったら
If Not IsError(x) Then
.Offset(0, 1).Value = Application.WorksheetFunction.VLookup(.Value, データ, 2, False)
.Offset(0, 2).Value = Application.WorksheetFunction.VLookup(.Value, データ, 3, False)
' ↑デバックするとここでとまっています (空白以外のとき)
Else 'なかったら
MsgBox .Value & " の店舗はありません！" _
& vbCrLf & vbCrLf & _
"モ・ウ・イ・チ・ド 店舗コードを確認してください...", _
vbExclamation + vbOKOnly + vbDefaultButton1, "コードエラー！"
End If
Else '空白だったら(消したら)右のデータも空白にする
.Offset(0, 1).Value = ""
.Offset(0, 2).Value = ""
' ↑空白のときはここです
End If
End If
Case 4 'Ｄ列だったら入力規則を解除
Target.Validation.Delete
End Select
End With
Set DWs = Nothing '変数の開放
Set NWs = Nothing
データ = Empty
Application.EnableEvents = True
Exit Sub
エラー:
' MsgBox "そのコードの店舗はありません！" _
' & vbCrLf & vbCrLf & _
' "モ・ウ・イ・チ・ド 店舗コードを確認してください...", _
' vbExclamation + vbOKOnly + vbDefaultButton1, "コードエラー！"
Application.EnableEvents = True
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Me.Protect , True, , , True
With Target
If .Count > 1 Then Exit Sub '２以上のセルは無効
If .Row <= 5 Then Exit Sub '５行目までは見出し等なので無効
If .Column <> 4 Then Exit Sub 'Ｄ列以外は無効
End With
With Target.Validation '入力規則でリストを設定する
.Delete
.Add Type:=xlValidateList, Formula1:="○,×,△"
.ShowError = False
End With
End Sub
http://ryusendo.no-ip.com/cgi-bin/upload/src/up0177.xls
すみません。
データ = Empty
を
Erase データ
に変更してください。おおぼけでした。m(__)m
2004/11/26 22:00
v(=∩_∩=)v
（SoulMan）
おお、やはり作っていた方が。
BeforeDoubleClickイベントのほうは問題なしと思われるので、
Changeイベントのみ試作してみました。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'宣言 ##########
Dim DWs As Worksheet, NWs As Worksheet
Dim データ As Range
Dim データチェック As Range
Dim C As Range
'設定 ##########
Set DWs = ThisWorkbook.Sheets("データ")
Set NWs = ThisWorkbook.Sheets("入力")
Set データ = DWs.Range("A2:C62") 'VLookupの照合範囲
Set データチェック = データ.Resize(データ.Rows.Count, 1) '店舗コードのチェック範囲
'On Error GoTo エラー '店舗コード入力間違いの際の飛び先
'チェック ##########
With Target
If .Columns.Count >= 2 Then Exit Sub '２列以上のセルの時は無効
If .Row <= 5 Then Exit Sub '５行目までは見出し等なので無効
If .Column >= 5 Then Exit Sub '５列目より右は無効
If .Column = 2 Or .Column = 3 Then Exit Sub '２列目３列目は無効
End With
'処理開始 ########## NWs.Unprotect 'シート保護解除 Application.EnableEvents = False 'イベント発生抑制
For Each C In Target 'Target中の各セルに対してFor Each間の処理
With C
If .Column = 1 Then 'Ａ列だったら
If .Value <> "" Then '空白じゃなかったら"順"と"店舗名"を記入
If Application.WorksheetFunction.CountIf(データチェック, .Value) = 0 Then GoTo エラー
.Offset(0, 1).Value = Application.WorksheetFunction.VLookup(.Value, データ, 2, False)
.Offset(0, 2).Value = Application.WorksheetFunction.VLookup(.Value, データ, 3, False)
' ↑デバックするとここでとまっています (空白以外のとき)
Else '空白だったら(消したら)右のデータも空白にする
.Offset(0, 1).Value = ""
.Offset(0, 2).Value = ""
' ↑空白のときはここです
End If
ElseIf .Column = 4 Then 'Ｄ列だったら入力規則を解除
With .Validation
.Delete
End With
End If
End With
Next C
Application.EnableEvents = True 'イベント発生抑制解除 NWs.Protect 'シート保護
'変数の解放 ########## Set データチェック = Nothing Set データ = Nothing Set DWs = Nothing Set NWs = Nothing Exit Sub
エラー:
MsgBox "そのコードの店舗はありません！" _
& vbCrLf & vbCrLf & _
"モ・ウ・イ・チ・ド 店舗コードを確認してください...", _
vbExclamation + vbOKOnly + vbDefaultButton1, "コードエラー！"
Application.EnableEvents = True
Target.Activate
End Sub なるべく原形を残したつもりでしたが、 やはり使い慣れた方法でないと思考がストップしてしまう。 変数データはやはりRange型にしてしまいました。 いかがなもんでせうか。 （みやほりん） #2004/11/26 23:40 店舗コードエラーチェック位置修正。 #でもエラーコード検出でループ抜けちゃうので、 #エラーラベルジャンプは再考したほうがいいかもしれません。
お返事大変遅くなりまして申し訳ございませんでした。
SoulManさん！みやほりんさん！完璧な回答をいただきありがとうございました。 いままで入力規則・関数・マクロの組み合わせで７MBくらいになってしまっていたので これでだいぶ軽く出来そうです。 「For Each」の使い方、少し勉強させていただきました。
ところで、みやほりんさんの >#でもエラーコード検出でループ抜けちゃうので、 >#エラーラベルジャンプは再考したほうがいいかもしれません。 少し教えていただけますでしょうか？ 動作をみて問題なさそうなのですが... それと、 On Error GoToがコメントでも問題ないのはなぜですか？
(TTC)
私が手を加えたコードではCountIf(データチェック・・・の部分で 店舗コード未検出の場合に即ループを抜けてエラーラベルへジャンプして しまいます。みっつのセルを同時処理したときに二つ目のセルでコードが 見つからない、みっつ目のセルの処理は放置して処理を終えてしまう構造 になっています。 （問題はありませんが、変数解放部分もスキップしてしまう） 基本的には「予想していない」エラーのみエラーラベルへジャンプさせたほうがいいです。 未設定コードの入力は「予想できる」エラーなので、ループ内にエラー処理を 組み込んで処理を継続する方が（私としては）納得できる処理の仕方です。 （SoulManさんのはそうなっているようですね） （みやほりん）
大変よく分かりました！ 確かに未設定コードをオートフィルするとメッセージは1つしか出ませんね。 勉強しながら考えて見たいと思います。
とても勉強になりました。ありがとうございました。
(TTC)
> PS.ここにコードをコピー&ペーストしたあと、先頭に１行１行空白をいれてます > なにか他によい方法がありますか？（インデントみたいな...）
参考です。ダウンロードしてお試し下さい。右クリックメニューから起動できます。 http://camaro.ddo.jp/Books/xl_school.xls (INA)
INAさん、ありがとうございます！！
すごのを作っていただきました！ 即、アドインに入れてしまいました。
活用させていただきます！
(TTC)
INAさん、べんりかも。 （みやほりん）
toみやほりんさん 感想ありがとうございます。(^^ゞ
ご近所PGさんにＣ言語で作るように課題を出されていたのですけど、 ひとまずVBAで作ってしまいました。(^_^;)
本当はユーザーフォームを使わないで 新規に開いたメモ帳を利用しようとしたのですけど、 無題メモ帳上のテキストの取得が上手く行かずに断念しました。 無題メモ帳にメッセージは送信できても、取得できなくて・・・ もしくは無題メモ帳の保存だけでも出来れば、 一時的に保存して、Openステートメントで処理できたのですけど・・(-_-;)
メモ帳が使えれば、タスクにも表示されるし、VBEのうえに開けるので、 断然使いかってがよかったので、かなり妥協してます。 開発したものは、VBEのショートカットメニューからも開けるようにしたのですが、 Windowの制御が安定しないし・・・（自己満足度３０％です。）(+_+)
書式の機能を追加してみようと考えているのですが、 どなたか、こちらの板のテキスト装飾の種類って分かりませんか？ (INA)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.