[[20110716100338]]　『セルをラジオボタンのようにする方法を教えてくだ』（hahaha）　ページの最後に飛ぶ

『セルをラジオボタンのようにする方法を教えてください』（hahaha）

 Excel2003を使用しています。
 下記例のような回答表をBVAを使用し作成したいと思っておりますが、
 うまく出来ませんでした。どなたかお力を貸して頂きたく質問致します。

 例）
 質問項目
 ①果物はすきですか？　　　□YES　　 □NO
 ②すきな果物は何ですか？　□リンゴ　□みかん　□ぶどう　□その他
 　　　　　・
 　　　　　・
 　　　　　・

 このようにいくつか質問項目があり、1つの質問に対して複数ある回答項目から
 1つだけ回答をユーザが答えるという表を作成したいと思っております。
 選択(□のセルをダブルクリック)をする事で、□が■に変換されるようにしたいです。

 この場合の条件として、1つの質問に対して、回答は1つだけ選択が出来るように
 したい為、もし①で、YESを選択し、やはりNOを選択し直した場合は
 Excelラジオボタンのように自動的にYESの選択が外れ、NOのみが選択されるように
 したいのです。
 そして、2つ目の条件は質問①と②はそれぞれ1つだけ回答を選択出来るように
 したいのです。
 質問①でYESを選択し、質問②でリンゴを選んでも質問①のYESの選択は外れない
 ようにしたいという事です。
 そして3つ目の条件は、回答して□が■となっていた際に改めて■を選択すると
 □へ戻る(何も回答していない状態へ戻す)ようにしたいのです。

 1つずつ条件を満たすVBAは作成できたのですが、3つの条件を満たすように出来ず
 困っております。

 質問項目が多数ある為、ラジオボタンではなくVBAを使用したいと思っております。

 質問が長くなり申し訳御座いません。宜しくお願い致します。

 選択されたときは同じ質問の他の選択肢を非選択に。
 選択解除されたときはその選択肢のみを非選択に。
 (r)

    質問毎に選択肢の範囲を名前定義でグループ化しておけば、

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        On Error Resume Next
        If Not Application.Intersect(Range("問01"), Target) Is Nothing Then
            Cancel = True
            Change■□ Target, Range("問01")
        End If
        If Not Application.Intersect(Range("問02"), Target) Is Nothing Then
            Cancel = True
            Change■□ Target, Range("問02")
        End If

    End Sub

    Private Sub Change■□(Target As Range, GroupRange As Range)
        Dim r As Range
        If Left(Target.Formula, 1) = "□" Then
            For Each r In GroupRange.Cells
                r.Formula = Replace(r.Formula, "■", "□")
            Next
            Target.Formula = Replace(Target.Formula, "□", "■")
        ElseIf Left(Target.Formula, 1) = "■" Then
            Target.Formula = Replace(Target.Formula, "■", "□")
        End If
    End Sub

    という感じで出来ると思います。

    (白茶)

 ＶＢＡでやるにしてもコントロールを配置して対応はできるけど、「セルで」ということなので。
 レイアウトとしては、□　と　Yes とか　りんご　のセルはわけておくコード。（□　の列幅は細めに）
 もちろん、□　りんご　が　１つのセルに同居している形なら、コードを少し変更すればＯＫ。
 とりあえず同一行をグルーピングの単位としている。

 シートモジュールに

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim tickY As String
    Dim tickN As String
    tickY = ChrW(9745)
    tickN = "□"
    Cancel = True
    Select Case Target.Value
        Case tickN   'Tickなし
            Target.EntireRow.Replace What:=tickY, Replacement:=tickN, LookAt:=xlWhole, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=False
                Target.Value = tickY
        Case tickY   'Tickあり
            Target.Value = tickN '9745に
    End Select
 End Sub

 ぶらっと立ち寄り

 □　りんご　同居なら

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim tickY As String
    Dim tickN As String
    Dim c As Range, r As Range
    Dim flagY As Integer, FlagN As Integer
    tickY = ChrW(9745)
    tickN = "□"
    flagY = InStr(Target.Value, tickY)
    FlagN = InStr(Target.Value, tickN)
    Cancel = True
    If FlagN > 0 Then
        Set r = Target.EntireRow.SpecialCells(xlCellTypeConstants)
        For Each c In r
            If InStr(c.Value, tickY) > 0 Then c.Value = Replace(c.Value, tickY, tickN)
        Next
        Target.Value = Replace(Target.Value, tickN, tickY)
        Set r = Nothing
    ElseIf flagY > 0 Then
        Target.Value = Replace(Target.Value, tickY, tickN)
    End If
 End Sub

 ぶらっと立ち寄り

 ｒ様、白茶様、ぶらっと立ち寄り様

 素早い対応ありがとうございます。
 教えて頂いたVBAを使用させてもらったところ、
 イメージ通りの回答表が作成できました。
 とても感謝しております。

 本当にありがとうございました。

 (hahaha)

コメント返信：

[ 一覧(最新更新順) ]

[[20110716100338]] 『セルをラジオボタンのようにする方法を教えてくだ』（hahaha） ページの最後に飛ぶ

[[20110716100338]]　『セルをラジオボタンのようにする方法を教えてくだ』（hahaha）　ページの最後に飛ぶ