『クリックによる文字変換』（BOXY）
 過去ログに同じようなものがありましたが、マウスのクリックだけで
 文字変換ができますか？
 セルにマウスを持っていって、「○」と「×」と「　」（キャンセル）の
 ３種類の文字の変換をしたいのですが････。
 右クリック、左クリック、シングルクリック、ダブルクリックの４つの
 組み合わせで、できるのでは？と期待しています。
 専門家の方のお知恵をお貸し下さい。よろしくお願いします。
----
 えっと、シングルクリック＝左クリックだと思いますが。
 シングルクリックでそのようなことを期待されますと、かなりうっとおしい動作になってしまいまっせ。
 (ROUGE)
----
 左ダブルクリックで「○」と「　」（空欄）の切り替え、右シングルクリックで
 「×」と「　」（空欄）の切り替え、ができないでしょうか？（BOXY）
----
 でけることはでけますけど、
 特定のセルに限定しとかなければ常にイベントが発生する事になりましからなぁ。
 そのシート＼Sheet1／タブを右クリックしてコード表示
 そこへ貼り付けてくらはい。
 A1からA5まで有効になっとります。
       　（弥太郎）
 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("a1:a5")) Is Nothing Then Exit Sub
    Cancel = True
    Application.EnableEvents = False
    Target = IIf(Target = "", "○", "")
    Application.EnableEvents = True
 End Sub

 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("a1:a5")) Is Nothing Then Exit Sub
    Cancel = True
    Application.EnableEvents = False
    Target = IIf(Target = "", "×", "")
    Application.EnableEvents = True
   
 End Sub

 
----
 弥太郎さん、シートとセルを限定して使用します。
 ありがとうございました。（BOXY）
----
 早速マウスクリックで入力を開始しましたが、入力するシートが
 ２種類あって「○」「×」の入力規則がないものでは問題ないのですが、
 あるものでは手入力の時に設定していた「入力規則」が効かず困っています。
 
 入力規則では、同じ行には連続する５列の中に１つだけ○が
 入るよう制限しています。
 
 例えば、
　　　　　A　　　B　　　C　　　D　　　E
　1　　　○
 
 A1からE1を入力規則で「=COUNTIF(A1:E1,"○")<2」として
 A1からE1のどれか１個のセルにしか"○"が入らない。
　
 マウスクリック入力の場合には、どのような入力規則にすれば
 いいのか教えて下さい。(BOXY)
----
 折角マクロを使うんですから入力規則などは止めまひょ。
 こんな塩梅でっか？
     　（弥太郎）
 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     
    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("a1:e5")) Is Nothing Then Exit Sub
    Cancel = True
    Application.EnableEvents = False
    data = IIf(Target = "", "○", "")
    If data = "○" Then
        Range("a1:e5").ClearContents
        Target = data
    Else
        Target = ""
    End If
    Application.EnableEvents = True

 End Sub

　
----
 弥太郎さん
 早速試してみましたが、３つ目の
 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As   Boolean)  のところで
 「コンパイルエラー（名前が適切ではありません）」と出てきました。（BOXY）

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("a1:a5")) Is Nothing Then Exit Sub
    Cancel = True
    Application.EnableEvents = False
    Target = IIf(Target = "", "○", "")
    Application.EnableEvents = True
 End Sub

 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("a1:a5")) Is Nothing Then Exit Sub
    Cancel = True
    Application.EnableEvents = False
    Target = IIf(Target = "", "×", "")
    Application.EnableEvents = True

 End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("a1:e5")) Is Nothing Then Exit Sub
    Cancel = True
    Application.EnableEvents = False
    data = IIf(Target = "", "○", "")
    If data = "○" Then
        Range("a1:e5").ClearContents
        Target = data
    Else
        Target = ""
    End If
    Application.EnableEvents = True

 End Sub
  



----
 イベントは重複して登録できません。
 一個にして下さい。
 (ROUGE)
----
 すみませんでした。３番目のマクロだけにしました。（BOXY）


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

    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("a1:e5")) Is Nothing Then Exit Sub
    Cancel = True
    Application.EnableEvents = False
    data = IIf(Target = "", "○", "")
    If data = "○" Then
        Range("a1:e5").ClearContents
        Target = data
    Else
        Target = ""
    End If
    Application.EnableEvents = True

 End Sub
 
 結果は、各行毎ではA列〜E列のいずれかしか「○」に
 なりませんが、２行目に○を入れると１行目の○が消えてしまい
 "A1:E5"の範囲で○が１つだけになってしまいます。
 「各行でA列〜E列で○が１つ」としたいのですが･･･。


 	A	B	C　　　　D　　　　E
 1		○	
 2		　　　　 ○	
 3	                                   ○		

		

		

----
 これだったらいかが？(ROUGE)
'----
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim rng As Range, data as String
    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("a1:e5")) Is Nothing Then Exit Sub
    Set rng = Intersect(Target.EntireRow, Range("a1:e5"))
    Cancel = True
    Application.EnableEvents = False
    data = IIf(Target = "", "○", "")
    If data = "○" Then
        rng.ClearContents
        Target = data
    Else
        Target = ""
    End If
    Application.EnableEvents = True
End Sub
----
 それともこっちか？(ROUGE)
'----
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim rng As Range, data As String
    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("a1:e5")) Is Nothing Then Exit Sub
    Set rng = Intersect(Target.EntireRow, Range("a1:e5"))
    Cancel = True
    Application.EnableEvents = False
    data = IIf(Target = "", "○", "")
    If data = "○" Then
        If Not WorksheetFunction.CountIf(rng, "○") > 0 Then Target = data
    Else
        Target = ""
    End If
    Application.EnableEvents = True
End Sub
----
 ROUGEさん

 >これだったらいかが？
 バッチリでした。
 
 >それともこっちか？
 ダメでした。
　
 ありがとうございました。
 これで、今夜は徹夜せずに済みそうです。
 謝！謝！（BOXY）


----
 上の方は、確認されているようですので省略。
 下の方は、すでに範囲に入力されている場合は、入力できないようにしています。
 ○がない状態の場合において、○が入るようにしています。
 (ROUGE)
----
 せんぱい〜！フォロー、デンキュー（笑
 いや、持つべきモンは心優しき弟子達。今年の年貢は免除（笑
 　　　　　今、夜しかアカン（弥太郎）
----
 ROUGEさん、入力する書式が変更になりました。（BOXY）
 A列〜C列のいずれかに「○」とF列〜H列のいずれかに「○」
 としたいのですが、どうすればいいでしょうか？
 マクロのセル範囲をRANGE"A1:D3,F1:H3"に変更したら
 G1に○が入るとA1の○が消えてしまいました。

 	A　　B　　C　　D　　E　　F　　G　　H　　　　
 1	○　　　　　　　　　　　　　　○	
 2　　　　　　 ○	　　　　　　　 ○
 3	         ○　　                  ○
----
 こんな感じですか？(ROUGE)
'----
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim rng As Range, data As String, adrs As String
    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("A1:D3,F1:H3")) Is Nothing Then Exit Sub
    Select Case Target.Column
        Case 1 To 4: adrs = "A1:D3"
        Case 6 To 8: adrs = "F1:H3"
    End Select
    Set rng = Intersect(Target.EntireRow, Range(adrs))
    Cancel = True
    Application.EnableEvents = False
    data = IIf(Target = "", "○", "")
    If data = "○" Then
        rng.ClearContents
        Target = data
    Else
        Target = ""
    End If
    Application.EnableEvents = True
End Sub
----
 当初の質問を元に作成してみますた。
 Wクリック-->○、Rクリック-->×　にしています。
 (ROUGE)
'----
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim rng As Range, data As String, adrs As String, c As Range
    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("A1:D3,F1:H3")) Is Nothing Then Exit Sub
    Select Case Target.Column
        Case 1 To 4: adrs = "A1:D3"
        Case 6 To 8: adrs = "F1:H3"
    End Select
    Set rng = Intersect(Target.EntireRow, Range(adrs))
    Cancel = True
    Application.EnableEvents = False
    data = IIf(Target = "", "○", "")
    If data = "○" Then
        For Each c In rng
            If c.Value = "○" Then c.ClearContents
        Next
        Target = data
    Else
        Target = ""
    End If
    Application.EnableEvents = True
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim rng As Range, data As String, adrs As String, c As Range
    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("A1:D3,F1:H3")) Is Nothing Then Exit Sub
    Select Case Target.Column
        Case 1 To 4: adrs = "A1:D3"
        Case 6 To 8: adrs = "F1:H3"
    End Select
    Set rng = Intersect(Target.EntireRow, Range(adrs))
    Cancel = True
    Application.EnableEvents = False
    data = IIf(Target = "", "×", "")
    If data = "×" Then
        For Each c In rng
            If c.Value = "×" Then c.ClearContents
        Next
        Target = data
    Else
        Target = ""
    End If
    Application.EnableEvents = True
End Sub
----
 ROUGEさん、ありがとうございます。（BOXY)
 
 最終のフォーマットが手に入りました。
 「○」「×」ではなく「レ点」代わりに「○」だけを記入して、
 その範囲はD6:F95とJ6:L95です。
 そこで、

 '----
 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As   
 Boolean)
    Dim rng As Range, data As String, adrs As String, c As Range
    If Target.Count > 1 Then Exit Sub
    If Application.Intersect(Target, Range("D6:F95,J6:L95")) Is Nothing Then  
 Exit Sub
    Select Case Target.Column
        Case 1 To 4: adrs = "D6:F95"
        Case 6 To 8: adrs = "J6:L95"
    End Select
→  Set rng = Intersect(Target.EntireRow, Range(adrs))
    Cancel = True
    Application.EnableEvents = False
    data = IIf(Target = "", "○", "")
    If data = "○" Then
        For Each c In rng
            If c.Value = "○" Then c.ClearContents
        Next
        Target = data
    Else
        Target = ""
    End If
    Application.EnableEvents = True
 End Sub

 に変更して実行しましたが、実行時エラー’1004':
 'Range'メソッドは失敗しました。'Worksheet'
 がでました。


----
 Targetの列数で分岐させていますので、その部分も変更しないとエラーになります。
 >       Case 1 To 4: adrs = "D6:F95"
 >       Case 6 To 8: adrs = "J6:L95"
       Case 4 To 6: adrs = "D6:F95"
       Case 10 To 12: adrs = "J6:L95"
 上記のように変更されたらどうでしょうか？
 (ROUGE)
 補足。
 変更前の場合、E列やF列でWクリックすると、adrs=""となっています。
 となると、
 Set rng = Intersect(Target.EntireRow, Range(""))
 となってしまい、rng Is Nothingとなってしまいます。
 SetステートメントではOn Error Resume Nextしていない限り、NothingはSetできないため、エラーとなっています。
----
 ROUGEさん
 
 早速ご指導の通りに変更して、ＯＫになりました。
 ありがとうございました。(BOXY)