Worksheet_Change、名前の定義で分岐

質問

エクセル2010です。
Worksheet_Change　イベントで、名前の定義で分岐させようと思います。
下記二つの方法は思いつきましたが、ほかにもっと良い方法はないでしょうか？
実際にはもっとたくさんの名前の定義があります。

・Intersectで見る方法
Private Sub Worksheet_Change(ByVal Target As Range)
　　Select Case True
　　Case Not Application.Intersect(Target, Range("見積日")) Is Nothing
　　　　Range("有効期限").Value = Range("見積日").Value + 60
　　Case Not Application.Intersect(Target, Range("Trigger")) Is Nothing
　　　　If Target(1).Value = "AAAA" Then '(1)は結合セルクリア対策
　　　　　　MsgBox "BBBBを入力してください。"
　　　　　　Range("BBBB").Select
　　　　Else
　　　　　　Range("BBBB").MergeArea.ClearContents
　　　　End If
　　Case Not Application.Intersect(Target, Range("BBBB")) Is Nothing
　　　　If Target(1).Value = "日付入力" Then
　　　　　　Range("BBBB").Value = InputBox("日付を入力してください。")
　　　　End If
　　End Select
End Sub

・アドレスで見る方法
Private Sub Worksheet_Change(ByVal Target As Range)
　　Select Case True
　 Case Target(1).Address = Range("見積日")(1).Address
　　　　Range("有効期限").Value = Range("見積日").Value + 60
　 Case Target(1).Address = Range("Trigger")(1).Address
　　　　If Target(1).Value = "AAAA" Then '(1)は結合セルクリア対策
　　　　　　MsgBox "BBBBを入力してください。"
　　　　　　Range("BBBB").Select
　　　　Else
　　　　　　Range("BBBB").MergeArea.ClearContents
　　　　End If
　　Case Target(1).Address = Range("BBBB")(1).Address
　　　　If Target(1).Value = "日付入力" Then
　　　　　　Range("BBBB").Value = InputBox("日付を入力してください。")
　　　　End If
　　End Select
End Sub

回答No.4

cj_mover · ベストアンサー

＃２-３、ｃｊです。＃３、お礼欄への返信です。

> よく考えると「名前の定義」を「ID」にするわけですから、「名前の定義」そのものを使っても同じことですよね？
少し違います。
# そこに重きを置くつもりはありませんが、説明は加えておきます。
名前が定義された単一セルの場合はわりと、似てはいますけれど、
.ID プロパティの場合は、問い合わせてもエラーになることはありません。
対して、
.Name プロパティで取得される.Name オブジェクト の.Name プロパティ
（こう ↑ 書いただけでアクセスする階層の深さも違うわけですが）
の場合は、
名前が定義された単一セル以外のすべてのセルでエラーを返します。
また、その為にわざわざ変数をひとつ余分に宣言している訳ですから、
簡単さ、という面で差は出ると思います。
無理に.ID プロパティを奨めようとしている訳ではなくて、
.Name.Name プロパティを扱う上で、限定的に考えた方がいいかな？
ということです。
名前が定義されたセル範囲がすべて単一セルで
入力作業に使う範囲の殆どに名前が定義されている、
というような限定的な条件でなら、.Name.Name で対応するのもアリ
とは思います。

> 「名前の定義」を「ID」に
いや、これも自分で自由に設定できる訳ですから、
個別のセルに任意の関連付けされた符号を、扱い易いように付ければいいだけなんです。
.ID プロパティの応用例で言えば、
簡単なテーブルやリスト、連想配列とか、辞書なんかの代用にも使える訳で。
例えば、
_Change イベントが発生したなら、
Targetに応じて分岐した３種のプロシージャ：hoge , piyo, fugaを実行する
なんてー場合、の効率化を考えると、
予め、各セルの.ID プロパティにそれぞれ"hoge", "piyo", "fuga"を設定しておけば、
　　Select Case Target.ID
　　Case "hoge", "piyo", "fuga"
　　　　Application.Run Target.ID
　　End select
なんて感じで、本来３つの分岐がひとつの条件分岐に簡略化される、
ようなことも、一応、可能な訳です。
＃２、の Sub LetNamedCellsID は、そのままでは、名前が定義された先頭のセルにだけ
.ID プロパティを設定するように書かれていますが、
これは、元のご質問の（名前が定義されたセル範囲の先頭セルだけ判別できればいいという記述）
　　Case Target(1).Address = Range("見積日")(1).Address
に合わせて、簡略化を図ったものです。
オプションとしてコメントブロックした方は、
名前が定義されたセル範囲すべてに.ID プロパティを設定するように書きましたが、
.ID プロパティに定義された名前を付けている理由は、元のご質問の
　　Case Not Application.Intersect(Target, Range("見積日")) Is Nothing
に合わせてIntersect メソッドの代用として、.ID プロパティを使えるように
という意図から来たものです。（テスト用サンプル Worksheet_SelectionChange 参照）
単一セルではない名前が定義されたセル範囲を扱う場合を想定してのもので、
こちらの方が可能性は高いかな、と思っています。
# 以上、認知度が低い.ID プロパティを弁護してみました。

> 現在、名前の定義が設定されているのが、単一セル(多数)、結合セル(多数)、そしてセル範囲もあります。
＃２で私が書いていた意味で言うと、単一セルではないのですから、
.Name.Name プロパティで分岐するのは不適切なケース、ということになるとは思います。
残念ながら、私としては、それ以外に示唆できる材料を持ち合わせておりません。

> セル範囲に名前を定義してから結合するとTarget(1).Name.Nameでは名前が取得できません。
単一セルではないのですから、何があっても驚きませんけれど、
新たな研究テーマとして掘り下げてみるのも面白いのかも知れませんね。

> 名前の管理で参照範囲を変更しなければいけませんでした。
逆に考えれば、参照範囲を設定し直せば、既存のブックも今よりは多少扱い易くなる
可能性を示唆しているということなのでは？

> 以下のコードのRange("CODE")はセル範囲ですが、結合はしていませんので問題ありません。

> ほかになにか問題はあるでしょうか？
微妙に動作仕様が変わっている気もしますが、そちらの要求には合致しているということなのでしょう。
ぱっと見（詳しく調べませんが）、問題と呼べる箇所は見つけられません。
うまく工夫できているのではないでしょうか。

ご自身の要求に沿って、ご自身で解り易くて管理し易ければ、それが正解でいいんじゃないでしょうか。
もし、そちらで動作上の問題点を見つけられたならまた相談にのります。

お礼

こんばんは。
とても丁寧にわかりやすくご教示いただき、本当にありがとうございました。
これでなんとか上手くいきそうです。
これからもご指導をよろしくお願いいたします。

回答No.3

cj_mover

＃２．ｃｊです。
....あいかわらず、タイプミスが多くて(^^;スミマセン。
こちらからの補足が２点あります。

またうっかり説明抜きでそのまま書いてしまいましたが、
_Change イベントで、.Value を変更する場合は、
　　Application.EnableEvents = False
　　.......、.Value = .......
　　Application.EnableEvents = True
のように書くのが基本です。
再び、_Change イベントが呼び出されることで無限ループ構造を作ること
を事前に避けておくものです。
ただ、ご提示のコードを見ると、
　必ずしも無くてもいいようなケースなのかも？
　ご承知の上で書かれたものなのでしょうし、、、
ということで、こちらも省いて書いています。
ただ、回答するものとしては、何の断りもなく省いてはいけませんね。
失礼しました。

> 名前を付けた範囲と完全に一致するセル範囲を指定した場合
や
> 名前を付けたセル範囲が、もしも、単一セルならば
という場合の記述ですが、普通に、
　　On Error Resume Next
　　sNameName = Target(1).Name.Name
　　On Error GoTo 0
　　If sNameName = "" Then Exit Sub
　　Select Case sNameName
　　・・・
という風になります。
ちょっと説明不足だったかなと思いました。
以上です。

お礼

cj_moverさん、いつもありがとうございます。
とても勉強になるコードを教えていただきました。
IDというのは面白いですね。それでやって見ましたが、よく考えると「名前の定義」を「ID」にするわけですから、「名前の定義」そのものを使っても同じことですよね？
現在、名前の定義が設定されているのが、単一セル(多数)、結合セル(多数)、そしてセル範囲もあります。
それで以下のようにして見ました。
すると一つだけ問題をみつけました。
「名前の定義」が単一セルは問題はありません。
結合セルの場合、セルを結合してから名前ボックスで名前を定義したものは問題ありません。
セル範囲に名前を定義してから結合するとTarget(1).Name.Nameでは名前が取得できません。
名前の管理で参照範囲を変更しなければいけませんでした。
以下のコードのRange("CODE")はセル範囲ですが、結合はしていませんので問題ありません。

ほかになにか問題はあるでしょうか？

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim myStr As String
　　On Error Resume Next
　　myStr = Target(1).Name.Name
　　On Error GoTo 0
　　Application.EnableEvents = False
　　If myStr <> "" Then
　　　　Select Case myStr
　　　　　　Case "見積日"
　　　　　　　　Range("有効期間").Value = Range("見積日").Value + 60
　　　　　　Case "Trigger"
　　　　　　　　If Target(1).Value = "AAAA" Then
　　　　　　　　　　MsgBox "BBBBを入力してください。"
　　　　　　　　　　Range("BBBB").Select
　　　　　　　　Else
　　　　　　　　　　Range("BBBB").MergeArea.ClearContents
　　　　　　　　End If
　　　　　　Case "BBBB"
　　　　　　　　If Target(1).Value = "日付入力" Then
　　　　　　　　　　Range("BBBB").Value = InputBox("日付を入力してください。")
　　　　　　　　End If
　　　　End Select
　　Else
　　　　If Not Application.Intersect(Target, Range("CODE")) Is Nothing Then
　　　　　　If MsgBox("その表を変更して本当にだいじょうぶですね？", vbYesNo + vbQuestion) = vbNo Then
　　　　　　　　Application.Undo
　　　　　　End If
　　　　End If
　　End If
　　Application.EnableEvents = True
End Sub

回答No.2

cj_mover

emaxemaxさん、こんにちは（＾＾）
んー、結構よく書けてると思いました。
ただ、設計としては少し強引なのかな？とも思います。
といって、こちらも決定的な解決策を提示できるかは、疑問なのですが。

まずは、テスト

Sub test1_8272726()
　　Dim sRef As String
　　Debug.Print Range("見積日").Name.Name
　　sRef = Mid(Range("見積日").Name.RefersTo, 2)
　　Debug.Print sRef

　　' ' アドレスで指定したRange、に設定された名前
　　Debug.Print Range(sRef).Name.Name
End Sub

一応こんな感じで、
名前を付けた範囲と完全に一致するセル範囲を指定した場合は
.Name.Name （.Nameオブジェクト（Rangeの.Nameプロパティ）の.Nameプロパティ）で、
セル範囲に設定された名前を取得できます。
なので、名前を付けたセル範囲が、もしも、単一セルならば、
ここまでの説明で解決しちゃうのかも知れません。

問題は
名前を付けたセル範囲が、単一セルでない場合です。
任意のセル範囲が、名前を付けた範囲に含まれているかどうか、
を返す直接的なプロパティやメソッドは用意されていません。

ちょっと話逸れますが、私個人の方法論としては、
頻繁に呼び出されるイベントプロシージャの記述に、
Intersect メソッドは、遅くて怖いので出来れば使いたくありません、
.Address プロパティも、.Count や .Row や .Column と比較すれば
桁違いに遅いので、優先度を下げて（或いは質問者に合わせて）
限定的に使う位です。
# いや、ご提示のコードは、ある意味、必要に迫られて書いているので、
私的にもオッケーなのですが、、、。
一言でいうと、イベントプロシージャは、速く、抜ける、
というのが、私の日頃からの拘りですし、実務でも実践しています。
そういう考えの元、何か、他に、速そうな方法はないかと、考えた結果、
ID プロパティを用いる方法（システム）を提案することにしました。

まず、標準モジュｒ－ル

Private Sub LetNamedCellsID() ' ID プロパティ　設定
　　Dim oNames As Names
　　Dim oName As Name
　　Dim r As Range
　　Dim sNameName
　　On Error Resume Next
　　For Each oName In ThisWorkbook.Names
　　　　sNameName = oName.Name

　　　　' ' シート の名前 の（ブック の名前 じゃない）場合は、
　　　　' ' "Sheet1!見積日"という名前が返るので、
　　　　' ' "Sheet1!"を除いて、"見積日"にしたい場合は、この行 ↓ イキ
　　　　If InStr(sNameName, "!") Then sNameName = Split(sNameName, "!")(1)

　　　　' ' 先頭セルにのみID設定　（１／２者）
　　　　oName.RefersToRange(1).ID = sNameName
　　　　' ' 名前がついたセル範囲すべてにID設定　（２／２者）
'　　　　For Each r In oName.RefersToRange
'　　　　　　r.ID = sNameName
'　　　　Next

　　Next
End Sub

Private Sub PrintNamedCellsID() ' ID プロパティ　確認用
　　Dim oNames As Names
　　Dim oName As Name
　　Dim r As Range
　　Dim sNameName
　　On Error Resume Next
　　For Each oName In ThisWorkbook.Names
　　　　sNameName = oName.Name
　　　　For Each r In oName.RefersToRange
　　　　　　If r.ID <> "" Then Debug.Print r.Address(0, 0), r.ID
　　　　Next
　　Next
End Sub

Private Sub EraseCellsID() ' ID プロパティ　消去
　　Dim oNames As Names
　　Dim oName As Name
　　Dim r As Range
　　Dim sNameName
　　On Error Resume Next
　　For Each oName In ThisWorkbook.Names
　　　　For Each r In oName.RefersToRange
　　　　　　r.ID = ""
　　　　Next
　　Next
End Sub

Sub LetNamedCellsID を実行して、
名前の付いたセル範囲の［先頭orすべての］セルについて
ID プロパティ に、名前を設定します。
次に
Sub PrintNamedCellsID を実行して、
ID プロパティ が設定されたセル範囲の
アドレスとID プロパティを確認します。
Sub EraseCellsID は一応、お行儀よく付け足しただけです。
ID プロパティ はブックの保存とは無縁に、
ブックを閉じれば消えて無くなります。

ここまでが準備です。

これをイベントプロシージャでどう活用するか、
イメージし易いように書いたテスト用サンプルが以下、
（シートモジュール）

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　If Target(1).ID <> "" Then MsgBox Target(1).ID
End Sub

名前の付いたセル範囲やその周辺をあちらこちら選択して
試してみてください。
Target.IDで、文字列値が返ります。
結構シンプルだと思いませんか？
テスト用サンプルは破棄してください。

では、本題です。（事前に Sub LetNamedCellsID を実行）

Private Sub Worksheet_Change(ByVal Target As Range)
　　Select Case Target(1).ID
　　Case "見積日"
　　　　Range("有効期限").Value = Target.Value + 60
　　Case "Trigger"
　　　　If Target(1).Value = "AAAA" Then
　　　　　　MsgBox "BBBBを入力してください。"
　　　　　　Range("BBBB").Select
　　　　Else
　　　　　　Range("BBBB").MergeArea.ClearContents
　　　　End If
　　Case "BBBB"
　　　　If Target(1).Value = "日付入力" Then
　　　　　　Range("BBBB").Value = InputBox("日付を入力してください。")
　　　　End If
　　End Select
End Sub

といった感じにで、軽くシンプルに速く抜けるように書けたと思います。

ブックを開く度に ID プロパティ を設定し直さないといけないのですが、
処理は速いです。

ThisWorkbookモジュール

Private Sub Workbook_Open()
　　Application.OnTime Now, "LetNamedCellsID"
End Sub

プロパティが無いならプロパティを作ってしまえ、的なやり方な訳ですが、
如何せん ID プロパティ 自体が、ExcelをExcelファイルとして使ってるうちは
日陰の存在、というか、レガシーなのかも？
なので、堂々と発信するものでもないのかも知れませんが、
工夫で何とかするとしたら、こんなのもアリ、だとは思います。
同じ発想でクラスモジュールを使うって人も、もしかしたら居るかも知れませんが、
却って重くなりそうな予感がして、私は考えてません。

以上、ご参考まで。
では、また。

お礼

ありがとうございます！

回答No.1

kmetu

条件分岐はIf文とSelect文しかなかったと思いますから、他に良い方法はないと思われます。

この場合、範囲に名前が定義されているのではなくてセルに名前が定義されているのですね。

としたら、Intersectで見る方法だと名前が範囲に対して定義されているように感じますので、アドレスで見る方法の方が、後々コードを見たときに誤解が生じないのではないでしょうか。そういう意味では、後者のほうがよろしいのではとも思えます。

また、沢山の名前の定義があるということですが、もしそのセルが何か一定のルールで配置されているのでしたら、名前の定義で分岐するよりも、変数を使ってCells(rwIndex, colIndex)などのように指定できれば、コードを短くすることができる可能性も出てきますがいかがでしょう。

お礼

ありがとうございます。
> もしそのセルが何か一定のルールで配置
そうだったら楽なんですが・・・。
もともとが他人様のおつくりになったワークシートにマクロで機能を付加しているのでなかなか思うようにいきません。
「名前の定義」でも、セルを結合してから名前ボックスで名前を定義したり、セル範囲に名前を定義してから結合したりと、バラバラで参ってます。