点在するセルを、ダブルクリックで変更したいのです。

質問

シート上に多数点在するセルを、ダブルクリックで変更したいのです。
下記の通り、数ヶ所のセルだと思い通りにセルが変更されるのですが
３０か。。。４０個目辺りのセルを追加して行くと突然動かなくなってしまいます。

Range(・・・・・・・) ←この中

物には限界があるのかな？と思いつつ、質問致します。
１２０セル位で動作させたいのですが、良いお知恵をお貸し下さいませ。
皆様宜しくお願い致します。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("A1,C1,F1,A3,C3,F3,A6,C6,E6," _
& "A8,C8,E8,A10,C10,F10,A12,C12,F12," _
& "A14,C14,F14,A17,D17,F17,A19,C19,F19")) Is Nothing = False Then
Cancel = True
If Target.Value = ChrW(10003) Then
Target.ClearContents
Else
Target.Value = ChrW(10003)
End If
End If
End Sub

回答No.3

mitarashi · ベストアンサー

ご質問の通りにやるならUnionを使えば良いと思います。ちょっと遊んでみました。
Dim setRange As Range

Sub test()
Dim i As Long
Dim myCell As Range

Randomize Time
Cells.Interior.ColorIndex = xlNone
For i = 1 To 120
Set myCell = Cells(Int(Rnd() * 100) + 1, Int(Rnd() * 100) + 1)
If setRange Is Nothing Then
Set setRange = myCell
Else
Set setRange = Union(setRange, myCell)
End If
myCell.Interior.Color = vbYellow
Next i
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If setRange Is Nothing Then test
If Not Intersect(Target, setRange) Is Nothing Then
Cancel = True
'cells(1)は、結合セル対策
If Target.Cells(1).Value = ChrW(10003) Then
Target.ClearContents
Else
Target.Value = ChrW(10003)
End If
End If
End Sub

代替案として、参照用のシートを用意し、Targetと同じ番地に特定の値が設定してあるときだけイベント動作をさせる方法があります。目的シートと同様のレイアウトをして、イベントを動作させたい番地だけ特定の値を入れておくと、分かり易いと思います。下記コードは、空か否かだけで分岐しています。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim refSheet As Worksheet

Set refSheet = ThisWorkbook.Sheets(2)
If Not IsEmpty(refSheet.Range(Target.Cells(1).Address)) Then
Cancel = True
If Target.Cells(1).Value = ChrW(10003) Then
Target.ClearContents
Else
Target.Value = ChrW(10003)
End If
End If
End Sub

お礼

いつもありがとうございます。

お礼が遅れましてすみません。
みなさん発想が凄くて面白い（失礼）です。

色々織り交ぜてなんとか希望通りのものが出来ました。

なんとなくUnionかなと思ったものの、示唆されないと自信無く実行に移せない・・・。

誠にありがとうございました<(_ _)>

回答No.2

tom04

こんにちは！
一案です。

Sheet2のA列にダブルクリックで反応させたいセル番地を列挙しておいてはどうでしょうか？

今回の場合だとSheet2のA1セル以降に
A1 C1 F1 A3 C3 F3・・・と反応させたいセルの数だけセル番地を入力しておきます。
そのうえで下のコードにしてみてください。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim str As String, c As Range
str = Target.Address(False, False)
Set c = Worksheets("Sheet2").Range("A:A").Find(what:=str, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Cancel = True
If Target.Value = ChrW(10003) Then
Target.ClearContents
Else
Target.Value = ChrW(10003)
End If
End If
End Sub

※　コード内の「Sheet2」の部分は実際にセル番地を入力させたSheet名にしてください。

こんな感じではどうでしょうか？m（_ _）m

お礼

お礼が遅れてすみません。

凄い一案で感激しました。こういうやり方もあるのですね～
シンプルで解りやすいでう。

ありがとうございました<(_ _)>

回答No.1

kmetu

たしか(）内の文字数は256文字までだったと思います。
チェックボックスをセットするのじゃだめなのでしょうか？

お礼

お礼が遅れましてすみません。。。

確かに、Range(・・・・・・・) の最後でZ115はOKでもAZ115ならNGとなっていました。
文字数に限度があった様ですね。
チェックボックスも考えたのですが、フォーム（シート上）に沢山作るのが大変そうだったので・・・諦めました。

ご助言ありがとうございました。