ＶＢＡでアプリケーションの作成

質問

ＶＢＡを使ってアプリケーションを作成しようとしています。内容は、３０個の質問に対してＹＥＳ・ＮＯどちらかを選択してもらい、ＹＥＳの数が１～１０，１１～２０，２１～３０個の場合に分け、結果表示ボタンをクリックするとそれに応じた結果が表れるといった感じです。何かアドバイス頂ければ幸いです。よろしくお願いします。

回答No.3

fumufumu_2006

こんなのはどうでしょう。

まず、
A1：YES
B1：NO
C1：質問
D1：結果表示
C2からC31：30個の質問

として、以下をシートのモジュールに書き込んでください。
質問のA列かB列を選ぶと、YES NO を表示して、結果表示を押すと、結果を表示します。
「結果表示」はどこにあってもいいです。
「クリア」も付けたので、どこかのセルを「クリア」にしてください。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'複数セル選択の場合は判定せず
If Target.Cells.Count > 1 Then
Exit Sub
End If
'選択表示
If Not Intersect(Range("A2:B31"), Target) Is Nothing Then
If Target.Column = 1 Then
Cells(Target.Row, 1) = "YES"
Cells(Target.Row, 1).Interior.ColorIndex = 3
Cells(Target.Row, 2) = ""
Cells(Target.Row, 2).Interior.ColorIndex = Null
Else
Cells(Target.Row, 1) = ""
Cells(Target.Row, 1).Interior.ColorIndex = Null
Cells(Target.Row, 2) = "NO"
Cells(Target.Row, 2).Interior.ColorIndex = 6
End If
End If
'結果表示
If Target.Text = "結果表示" Then
If WorksheetFunction.CountIf(Range("A2:B31"), "") <> 30 Then
MsgBox "全部選ばれていません"
Else
Dim msg As String
Select Case WorksheetFunction.CountIf(Range("A2:A31"), "YES")
Case 0: msg = "なし"
Case 1 To 10: msg = "1-10です"
Case 11 To 20: msg = "11-20です"
Case 21 To 30: msg = "21-30です"
End Select
MsgBox msg 'メッセージボックスに表示する場合
Target.Offset(0, 1) = msg '「結果表示」の右側に表示する場合
End If
End If
'クリア
If Target.Text = "クリア" Then
If MsgBox("クリアしてもいいですか?", vbYesNo) = vbYes Then
Range("A2:B31").Value = ""
Range("A2:B31").Interior.ColorIndex = Null
End If
End If
End Sub

回答No.2

spar

おはようございます
駄作ですが、おおまかにこんなモノかと思われます
参考になれば幸いです

Dim Kotae As Integer
Private Sub CommandButton1_Click()
Kotae = 0
If MsgBox("どっち？", vbYesNo, "質問１") = vbYes Then
Kotae = Kotae + 1
End If
If MsgBox("どっち？", vbYesNo, "質問２") = vbYes Then
Kotae = Kotae + 1
End If
If MsgBox("どっち？", vbYesNo, "質問３") = vbYes Then
Kotae = Kotae + 1
End If
If MsgBox("どっち？", vbYesNo, "質問４") = vbYes Then
Kotae = Kotae + 1
End If
If MsgBox("どっち？", vbYesNo, "質問５") = vbYes Then
Kotae = Kotae + 1
End If
If MsgBox("どっち？", vbYesNo, "質問６") = vbYes Then
Kotae = Kotae + 1
End If

If Kotae <= 1 Then
MsgBox "少ない？"
ElseIf Kotae >= 2 And Kotae <= 4 Then
MsgBox "まあまあ"
ElseIf Kotae >= 5 And Kotae <= 6 Then
MsgBox "多いなぁ"
End If
End Sub

回答No.1

lark_0925

もうだいぶ以前の話になりますが、私の地元のちょっとした
イベント（お祭り）の出店（出店っていうのかなあ）で
仰っているようなアンケート（診断表なのかな）をExcel／ＶＢＡで
作成したもので公開しているのを見た事がありました。

当時は、私もＶＢＡを始めて間もない頃でしたので、内容よりも
その動作（仕様）が気になってＰＣを独占してしまったころを
よく覚えていますが・・・。
前置きは長くなりましたが、そのときは、シートに開始のボタンが
設置されていて、クリックすると、

Msgbox関数で質問を表示し、オペレータに　Yes　Noのボタンのクリックを
促し、その繰り返しでYesの数を数える仕様でしたよ！！

Sub test()
　　Dim ans As Long
　　ans = MsgBox("貴方は　男ですか？", vbYesNo)
　　msgbox ans
End Sub