エクセルVBA/Intersect(Target,～について

質問

ワークシート上の名前を定義された特定の個所（結合セル）を選択すると、その部分が黄色く変わるマクロです。
一応、動くのですが、例えば印刷範囲を選択などしてしまうと印刷範囲すべてが黄色くなってしまいます。

If Target.Count >1 then Exit Sub だと、結合セルに名前を定義しているので、一ヶ所だけ選択しても色が変わらなくなります。
　　　If Selection.Areas.Count >1 then Exit Sub だと、一遍に連続した範囲を選択してもAreasは１ですからだめです。
　　　Range( "会社名,日付,物件,電話番号,売上高,店名,担当者")の6つの名前を定義された結合セル範囲のなかのどれか一ヶ所だけが選択された場合のみ作動するようにするにはどう書けばよいのでしょうか？

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Set Rng = Range( "会社名,日付,物件,電話番号,売上高,店名,担当者")
If Intersect(Target, Rng) Is Nothing Then Exit Sub

Rng.Interior.ColorIndex = 2
Selection.Interior.ColorIndex = 6

End Sub

回答No.6

end-u · ベストアンサー

こんにちは。
>If Target.Count >1 then Exit Sub だと、結合セルに名前を定義しているので、一ヶ所だけ選択しても色が変わらなくなります。
>If Selection.Areas.Count >1 then Exit Sub だと、一遍に連続した範囲を選択してもAreasは１ですからだめです。
ここの着眼点は間違ってないですね。
単純にRng(.Cells).Countで判定すれば良いと思います。（縦方向の結合セルにも対応）

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　Dim Rng As Range

　　With Range("XXX,YYY,ZZZ")
　　　　.Interior.ColorIndex = xlNone
　　　　Set Rng = Intersect(Target, .Cells)
　　End With
　　If Not Rng Is Nothing Then
　　　　If Rng.Count = 1 Then Rng.Interior.ColorIndex = 6
　　　　Set Rng = Nothing
　　End If
End Sub

お礼

end-uさま、ありがとうございました。

完璧です。助かりました。

回答No.5

Wendy02

こんばんは。

今、私のほうでは、余裕がないので試行錯誤するということが出来ません。VBAでは、不得意とする、「結合セル」と「名前登録」の両方があるのでは、難しいです。

>PrintAreaを選択すると
なぜ、それが関係しているのか分からないです。

myRng.Areas(1).Cells.Count = 1
選択した範囲のセルの数が、1個ではないわけですから、myRng.MergeCells が、True になるということですね。そこらへんが、こちらの想定した内容とは、想像が付きません。Version が違うと、判定が違ってくるのかな？何か、ありえないような気がしてくるのです。

Set myRng = Intersect(Target, rng)

こちらでは、内容は読めませんから、早い話、ここで、内容をチェックして、その内容から、どういう性質のものを除外するのを決めればよいのではないでしょうか？

たとえば、MsgBox myRng.Address で、違う内容を判定する材料を決めればよいと思います。

ただ、結合セルも単純にひとつの範囲でないとすれば、それは、難しいですね。そういう、「名前登録」というもので判定する、設定範囲任せのマクロを作ったことがありません。前にも書いたような気がしますが、Select した範囲から、逆に名前を判定するというようなことは、ひどくややこしいと思います。私なら、何らかの状況によっては、それは、エラーを招くので、そのようなコードの作り方はしないというだけです。

それに、
Target.Interior.ColorIndex = 6　が、その手前で、正しく除外しているなら、MyRng もTarget も同じはずですね。

Target で、色が全部変わるというのは、除外判定の論理が違っていることでしょうけれども、myRng.MergeCells が、True で、抜けてしまうということを考えると、今の段階では、見当が付かないです。Null で抜けてしまうとしたら、n = MyRng.MargeCells -> (Not IsNull(n) And n) のような措置を加えなくてはならないように思いますが。

お礼

Wendy02さま、何度も有難うございます。
以下のコードで目的を達しました。
いつもお世話様です。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myRng As Range
Dim rng As Range
Set rng = Range("会社名,日付,物件,電話番号,売上高,店名,担当者")
Set myRng = Intersect(Target, rng)
If Not myRng Is Nothing Then
' If myRng.MergeCells Or myRng.Areas(1).Cells.Count = 1 Then
If myRng.Count = 1 Then
rng.Interior.ColorIndex = xlNone
myRng.Interior.ColorIndex = 6
End If
End If
Set myRng = Nothing
Set rng = Nothing
End Sub

回答No.4

onlyrom

ちょこっと手抜きしてありますが、、質問の件であれば上手くいきます。

'----------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　Dim Rng As Range
　Dim myRange As Range
　Dim N As long

　Set Rng = Range("会社名,日付,物件,電話番号,売上高,店名,担当者")

　Rng.Interior.ColorIndex = xlNone

　Set myRange = Intersect(Target, Rng)
　　If myRange Is Nothing Then Exit Sub
　　With myRange
　　　For N = 1 To .Cells.Count - 1
　　　　If .Cells(N).MergeArea.Address <> .Cells(N + 1).MergeArea.Address Then Exit Sub
　　　Next N
　　End With

'''　　Rng.Interior.ColorIndex = xlNone
　　myRange.Interior.ColorIndex = 6
End Sub
'----------------------------------------------------

以上です。

お礼

onlyromさま、ご教示のコードでうまく行きました。
ありがとうございました。

With myRange
For N = 1 To .Cells.Count - 1
If .Cells(N).MergeArea.Address <> .Cells(N + 1).MergeArea.Address Then Exit Sub
　　　Next N
End With
myRange.Interior.ColorIndex = 6

の部分を
If myRange.Count = 1 Then myRange.Interior.ColorIndex = 6
としてみてもOKでした。

回答No.3

onlyrom

いまいち不明な部分がありますので、細かいことまで考えてしまいます。(^^;;;

会社名＿＿＿＿＿物件＿＿＿
Ｂ４（結合）　＿＿Ｃ４＿＿＿
Ｂ５＿＿＿＿＿＿Ｃ５＿＿＿
Ｂ６（結合）　＿＿Ｃ６＿＿＿
Ｂ７＿＿＿＿＿＿Ｃ７＿＿＿
Ｂ８（結合）　＿＿Ｃ８＿＿＿
Ｂ９＿＿＿＿＿＿Ｃ９＿＿＿

（名前）
会社名（Ｂ４：Ｂ９）２セルずつ結合
物　件（Ｃ４：Ｃ９）結合なし

上記のような表の場合でお訊ねします。

●選択範囲に名前付きセルが、１つ、入っていた場合にそのセルに色付けするということですか？

　Ａ８：Ｂ１０を選択したら、Ｂ８（：Ｂ９）に色付け
　Ｃ９：Ｆ１０を選択したら、Ｃ９に色付け

●それとも完全に名前付きセルのみ、１つ、選択したら色付けということですか？

　Ｂ６（：Ｂ７）のみ選択したら、色付け
　Ｃ８　のみ選択したら　色付け
　Ｂ６：Ｃ７　を選択したら、色付けしない

そこら辺りが明確に分かると回答しやすいかも。

お礼

何度も有難うございます。(o。_。)oペコッ

一つの「名前の定義」には範囲は一つしかありません。
例えば、A1:C1を結合して「会社名」
A2:C2を結合して「電話番号」
A3:C3を結合して「物件」
E1単独セルで「日付」
E2単独セルで「売上高」　　といった感じです。

ですから「会社名」を選択すれば「会社名」（A1:C1結合セル）が、「日付」を選択すれば「日付」（E1単独セル）が黄色になり、選択されていない名前の定義は白くなって欲しいのです。
ご教示のコードでもそれは実現していますが、仮にシート全体を選択すれば、すべての名前の定義が黄色くなります。
こんな場合や、複数の名前の定義を選択したような場合には、イベントが発生しないようにしたいのです。

よろしくお願い申し上げます。

回答No.2

Wendy02

こんにちは。

名前-登録を使用しているので、厳密には状況は読めないのですが、たぶん、複数の場所を選択するときには、MergCells プロパティの値は、正しく返らないはずですから、それを応用すればよいのではありませんか？
また、それ以外のArea の場合には、Cells の数を数えればよいと思います。

-------------------------------------

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myRng As Range
Dim rng As Range
Set rng = Range("会社名,日付,物件,電話番号,売上高,店名,担当者")
Set myRng = Intersect(Target, rng)
　If Not myRng Is Nothing Then
　 If myRng.MergeCells Or myRng.Areas(1).Cells.Count = 1 Then
　　　rng.Interior.ColorIndex = xlNone
　　　Target.Interior.ColorIndex = 6
　 End If
　End If
Set myRng = Nothing
Set rng = Nothing
End Sub

お礼

ありがとうございます。

Target.Interior.ColorIndex = 6　は
myRng.Interior.ColorIndex = 6　ですよね？（そうしないと選択した部分が全部黄色になります）

で、それでやったのですが、やはりPrintAreaを選択すると会社名,日付,物件,電話番号,売上高,店名,担当者がすべて黄色になってしまいます。（それらはすべてPrintArea内です）

回答No.1

onlyrom

＞Selection.Interior.ColorIndex = 6

こんなことをすれば、選択範囲が無条件に塗りつぶされるのでは？
Intersect(Target, Rng)で取得したセルだけ塗ればいいと思いますが。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　Dim rng As Range
　Dim myRange As Range
　Set Rng = Range( "会社名,日付,物件,電話番号,売上高,店名,担当者")
　Set myRange = Intersect(Target, rng)
　If myRange Is Nothing Then Exit Sub
　rng.Interior.ColorIndex = xlNone
　myRange.Interior.ColorIndex = 6
End Sub
'------------------------------------------

Intersectは変数で受けた方がベターだと思われます。
以上。

お礼

さっそくありがとうございます。

ご指摘ありがとうございます。そのとおりでした。
ただ、ご教示のコードでも、仮に全セル選択や印刷範囲選択をやった場合、Range( "会社名,日付,物件,電話番号,売上高,店名,担当者")のすべてが黄色になってしまいます。

名前を定義された６つある結合セル範囲のなかのどれか一つだけが選択された場合のみ、このマクロが作動するようにするにはどう書けばよいのでしょうか？