エクセルvba初心者です。○をつけるプログラム

質問

以前どなたかが質問していた際に、下記の様なコードで回答をていた方がいらっしゃいます。
これを流用させていただきたいと思っています。そこで、下記の通り２点ほど改良をくわえたいのですが、どうすればいいのでしょうか。

改良点１
現在は、このコードは１つ１つのセルに対しての処理になっています。（結合したセルではうまくいかない。）自分がやりたいのは、Ｏ24からT25までという感じに結合されたセルに対して、このようにダブルクリックすると○が入り、再びダブルクリックすると○が消える。ということをしたいのです。

改良点２
下記のコードだと、A1からA5のように連続したセルに対する処理になっていますが、自分としては、O24からT25までの結合したセルと、V24からAA25までの結合したセルと、AC24からAC25までの結合したセルと、AJ24からAO25までの結合したセルと、AQ24からAV25までの結合したセルと、AX24からBC25までの結合したセルの計6カ所に○をつけたり消したりするようにしたいです。

何とかならないものでしょうか。VBAはかなり初心者です。お願いします。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim Ad As String
Dim Lp As Single, Tp As Single, Hp As Single
Dim Ov As Oval

If Intersect(Target, Range("A1：A5")) Is Nothing Then
Exit Sub
End If
With Target
Ad = .Address
Hp = .Height
Lp = .Left + ((.Width / 2) - (Hp / 2))
Tp = .Top
End With
Cancel = True
With ActiveSheet
.Unprotect '★
For Each Ov In .Ovals
If Ov.TopLeftCell.Address = Ad Then
Ov.Delete: Ad = "": Exit For
End If
Next
If Ad <> "" Then
.Ovals.Add(Lp, Tp, Hp, Hp) _
.Interior.ColorIndex = xlColorIndexNone
End If
.Protect , True, False, False '★
End With
End Sub

回答No.2

at121 · ベストアンサー

マークする範囲は　　Set Mark = Range("A1：D5, A10：D15, E6：G9")　　で複数範囲を
自分のシートに合わせて書き換えて応用してしてください。　
備考：　赤○にして確認した。　Exit For　は　○の重複◎がある場合に備え消し優先にするために外した。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Mark　の複数の範囲のセル/結合セルに　Wクリックで　赤○　つける/消す
Dim Ad As String
Dim Lp As Single, Tp As Single, Hp As Single
Dim Ov As Oval, Mark As Range

Set Mark = Range("A1：D5, A10：D15, E6：G9") '範囲の複数指定
If Intersect(Target, Mark) Is Nothing Then Exit Sub '範囲外は無視

With Target
Ad = .Address: Hp = .Height: Tp = .Top
If .Height > .Width Then Hp = .Width '縦長結合の場合に備える
Lp = .Left + ((.Width / 2) - (Hp / 2))

End With
Cancel = True

With ActiveSheet
.Unprotect '★
For Each Ov In .Ovals
If Not (Intersect(Target, Ov.TopLeftCell) Is Nothing) Then '既存○検出
Ov.Delete: Ad = "": ' Exit For '◎重複があるなら外し、削除優先する
End If
Next
If Ad <> "" Then
With .Ovals.Add(Lp, Tp, Hp, Hp)
.Interior.ColorIndex = xlColorIndexNone
.Border.Color = vbRed '　赤○にする
End With
End If
Protect , True, False, False '★
End With
End Sub

お礼

ありがとうございます。
思いっきりイメージ通りになりました！
本当に助かりました！すごいですね！

回答No.1

noname#146604

改良点２について何をしたいのか伝わらないので、１だけ

Private Sub Worksheet_BeforeDoubleClick(ByVal mycell As Range, Cancel As Boolean)

Select Case mycell.Text
Case "○"
mycell = ""
Case ""
mycell = "○"
End Select

End Sub

補足

お返事本当にありがとうございます。
すみません。説明不足でした。書いてくださったプログラムを試してみたのですが、私が流用させていただいたプログラムはもともとセルの中にはテキストとして文字が入力されていても、その文字の上に丸をつけたり消したりするプログラムです。

できれば投稿したプログラムをなるべく生かす様にしたいです。
今のままだと、結合されたセルに対してはうまく動かないので、結合されたセルに対しても動くようにしたいのです。

改良点２の方はよくわからない言い方になってしまってすみません。

If Intersect(Target, Range("A1：A5")) Is Nothing Then
の部分ですが、この場合はセルA1：A5に対してはダブルクリックすると○がついたり消えたりしますよね。

それを、たとえばA1とA2とB1とB2の４つのセルが１つに結合されたセルと、少し離れた場所にあるG1とG2とH1とH2の４つのセルが１つに結合されたセルのように、結合されたセルが連続してない離れた場所に存在する場合に、その離れた場所に複数ある結合されたセルを対象範囲にしたいと考えています。

VBAでは結合されたセルに対して何かするというのは難しいのでしょうか。