[[20170324050337]]　『アンケート結果』（K）　ページの最後に飛ぶ

『アンケート結果』（K）

下記コードでアンケート集計をしていますが　現在年齢と来店動機を複数入力できるようにしていますが
これを　メーカー（テキストボックス１）ナンバーも複数　数量も（テキストボックス２）複数
打てる様にしたいのですが
メーカーNO　１、２、１５、３０
数量　　１、１、２、２、１５、１５、３０　と打つと
メーカーNO　１　には２票入り　２には２票　１５も２票　３０は１票となります
そして　来店動機と年齢はメーカー別は必要ないので　３行目に合計を出していきたいのですが
どう書き換えればいいでしょうか

Private Sub CommandButton1_Click()

    'アンケート番号数
    Const mxMaker As Long = 174
    Const mxReason As Long = 14
    Const mxAge As Long = 21
    '===========================
    Dim i As Long
    Dim k As Long
    Dim j As Long
    Dim h As Variant
    Dim myRow As Long
    Dim erMsg As String
    Dim erTxt As Long
    Dim w As Variant
    Dim d As Variant
    Dim w4 As Variant
    'TextBox1のチェック
    k = Val(TextBox1.Value)
    Select Case k
        Case 1 To mxMaker        'メーカNo に対するアンケート番号
            myRow = k + 4
        Case Else
            erMsg = "メーカNo は1 から " & mxMaker & " の数値で入力してください"
            erTxt = 1
    End Select
    'TextBox2のチェック
    If Not IsNumeric(TextBox2.Value) Then
        erMsg = "数量は数字で入力してください"
        erTxt = 2
    End If
    i = Val(TextBox2.Value)
    'TextBox3のチェック
    If TextBox3.Value = "" Then
        erMsg = "来店動機を入力してください"
    Else
        w = Split(TextBox3.Value, ",")
        For Each d In w
            If Not IsNumeric(d) Then
                erMsg = "来店動機は数字で入力してください"
                erTxt = 3
            Else
                Select Case d
                    Case 1 To mxReason     '来店動機に対するアンケート番号
                    Case Else
                        erMsg = "来店動機は1 から　" & mxReason & " の数値で入力してください"
                        erTxt = 3
                End Select
            End If
            If erTxt = 3 Then Exit For
        Next
    End If
    'TestBox4のチェック
    If TextBox4.Value = "" Then
        erMsg = "年齢を入力してください"
        erTxt = 4
    Else
        w4 = Split(TextBox4.Value, ",")
        For Each h In w4
            If Not IsNumeric(h) Then
                erMsg = "年齢は数字で入力してください"
                erTxt = 4
                Exit For
            Else
                Select Case h
                    Case 15 To mxAge
                    Case Else
                        erMsg = "年齢は 15から　" & mxAge & " の数値で入力してください"
                        erTxt = 4
                        Exit For
                End Select
            End If
        Next
    End If
'    h = Val(TextBox4.Value)
'    Select Case h
'        Case 1 To mxAge
'        Case Else
'            erMsg = "年齢は 15から　" & mxAge & " の数値で入力してください"
'            erTxt = 4
'    End Select
    If erTxt > 0 Then
        MsgBox erMsg
        With Me.Controls("TextBox" & erTxt)
            .SelStart = 0
            .SelLength = .TextLength
            .SetFocus
            Exit Sub
        End With
    End If
    With Sheets("Sheet1")
        .Cells(k + 4, 5).Value = .Cells(k + 4, 5).Value + i
        For Each d In w
            .Cells(k + 4, d + 7).Value = .Cells(k + 4, d + 7).Value + 1     
        Next
        End With
        With Sheets("Sheet1")
        For Each h In w4
            .Cells(k + 4, h + 7).Value = .Cells(k + 4, h + 7).Value + 1
           Next
'     
    End With
    TextBox1.Value = ""
    TextBox2.Value = ""
    TextBox3.Value = ""
    TextBox4.Value = ""
    TextBox1.SetFocus
 End Sub

 .Cells(k + 4, d + 7).Value = .Cells(k + 4, d + 7).Value + 1 ここのK＋４を３にしてみたのですが
1度目はいきますが足し算ができませんでした
 .Cells(k + 4, h + 7).Value = .Cells(k + 4, h + 7).Value + 1　ここも同じです

３行目　　　　　　　　　　　　　　　来店動機　１　２　３　～１５　年齢１５～２１
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　

　　C　　　　　　D　　　　E
メーカーNO　メーカー名　得票数　

仕事の都合ですぐにはお礼ができませんが　宜しくお願い致します。

＜使用 Excel：Excel2012(Mac)、使用 OS：MacOSX ＞

 コードや要件は、まだ詳しく見ていませんが

 >メーカー（テキストボックス１）ナンバーも複数　数量も（テキストボックス２）複数 打てる様にしたいのですが

 過去トピ

[[20150913073204]]　『ユーザーフォーム』（k）

 ここでも（複数入力に関しては）同じような質問でしたね。
 つまり、当時、動機については、すでにSplitを使った複数入力コードになっていた。
 で、年齢についても、そうしたいという質問で、同じように Split処理をしたらいいですよと回答しましたよね。

 現時点では、動機、年齢については複数入力対応になっているわけで、加えて、メーカ、数量　についても
 同じことをしたい？？

 であれば、まずは、そこも、他と同様 Split処理を加えるということが第一歩でしょ？

 複数入力されたものを合計したいとか、そういったことはあると思いますが、まずは　Split処理まで行って
 分解されたものを扱うコードまでは、自分で頑張って書けませんか？

 そのうえで、壁があれば、その部分を具体的に、どうわからないのかを書いてSOS出すべきではないですか？

（β） 2017/03/24(金) 08:25

申し訳ありません

いくらやってもわからないので　このまま使います　ありがとうございました。
（K） 2017/03/24(金) 21:12

先日は　時間がないので　このまま使いますのコメントを入れさせていただきました

再度見直して　同じ場所への入力はできましたが

テキストボックス１でのsplitで　型が合いませんと出ます　他の所と同じ様にしたのですが　ご教授お願いします
Private Sub CommandButton1_Click()

    'アンケート番号数
    Const mxMaker As Long = 174
    Const mxReason As Long = 14
    Const mxAge As Long = 21
    '===========================
    Dim i As Long
    Dim k As Variant
    Dim j As Long
    Dim h As Variant
    Dim myRow As Long
    Dim erMsg As String
    Dim erTxt As Long
    Dim w As Variant
    Dim d As Variant
    Dim w4 As Variant
    Dim km As Variant
    'TextBox1のチェック
    k = Split(TextBox1.Value, ",")
        For Each km In k  このkが反転して出ます
            If Not IsNumeric(km) Then
                erMsg = "数字で入力してください"
                erTxt = 1
            Else
                Select Case km
                    Case 1 To mxMaker
                    Case Else
                        erMsg = "1 から　" & mxMaker & " の数値で入力してください"
                        erTxt = 1
                End Select
            End If
            If erTxt = 1 Then Exit For
        Next
'    k = Val(TextBox1.Value)
'    Select Case k
'        Case 1 To mxMaker        'メーカNo に対するアンケート番号
''            myRow = k + 4
'        Case Else
'            erMsg = "メーカNo は1 から " & mxMaker & " の数値で入力してください"
'            erTxt = 1
'    End Select
    'TextBox2のチェック
    If Not IsNumeric(TextBox2.Value) Then
        erMsg = "数量は数字で入力してください"
        erTxt = 2
    End If
    i = Val(TextBox2.Value)
    'TextBox3のチェック
'    If TextBox3.Value = "" Then
'        erMsg = "来店動機を入力してください"
'    Else
        w = Split(TextBox3.Value, ",")
        For Each d In w
            If Not IsNumeric(d) Then
                erMsg = "来店動機は数字で入力してください"
                erTxt = 3
            Else
                Select Case d
                    Case 1 To mxReason     '来店動機に対するアンケート番号
                    Case Else
                        erMsg = "来店動機は1 から　" & mxReason & " の数値で入力してください"
                        erTxt = 3
                End Select
            End If
            If erTxt = 3 Then Exit For
        Next
'    End If
    'TestBox4のチェック
'    If TextBox4.Value = "" Then
'        erMsg = "年齢を入力してください"
'        erTxt = 4
'    Else
        w4 = Split(TextBox4.Value, ",")
        For Each h In w4
            If Not IsNumeric(h) Then
                erMsg = "年齢は数字で入力してください"
                erTxt = 4
                Exit For
            Else
                Select Case h
                    Case 15 To mxAge
                    Case Else
                        erMsg = "年齢は 15から　" & mxAge & " の数値で入力してください"
                        erTxt = 4
                        Exit For
                End Select
            End If
        Next
'    End If
'    h = Val(TextBox4.Value)
'    Select Case h
'        Case 1 To mxAge
'        Case Else
'            erMsg = "年齢は 15から　" & mxAge & " の数値で入力してください"
'            erTxt = 4
'    End Select
    If erTxt > 0 Then
        MsgBox erMsg
        With Me.Controls("TextBox" & erTxt)
            .SelStart = 0
            .SelLength = .TextLength
            .SetFocus
            Exit Sub
        End With
    End If
    With Sheets("Sheet1")
        .Cells(k + 4, 5).Value = .Cells(k + 4, 5).Value + i
        For Each km In k
            .Cells(km + 4, 5).Value = .Cells(km + 4, 5).Value + 1
        Next
        End With
    With Sheets("Sheet1")
        .Cells(k + 4, 5).Value = .Cells(k + 4, 5).Value + i
        For Each d In w
            .Cells(k + (4 - 2), d + 7).Value = .Cells(k + (4 - 2), d + 7).Value + 1
        Next
        End With
        With Sheets("Sheet1")
        For Each h In w4
            .Cells(k + (4 - 2), h + 7).Value = .Cells(k + (4 - 2), h + 7).Value + 1
           Next

    End With
    TextBox1.Value = ""
    TextBox2.Value = ""
    TextBox3.Value = ""
    TextBox4.Value = ""
    TextBox1.SetFocus
 End Sub

（K） 2017/03/26(日) 09:56

 変更トライ、お疲れ様でした。

 コードが正しいかどうかは、まだ詳細には見ていませんが、少なくとも
 k = Split(TextBox1.Value, ",") も  For Each km In k  も、エラーにはならないはずですが？

 実際に TextBox1 には、どんな文字列を入力しましたか？
 またエラーになったコード、本当に、そこでしたか？

（ β） 2017/03/27(月) 09:38

（ β）様

ありがとうございます。

やはりFor Each km In k このkが反転して出ます

コンパイルエラーFor Each はコレクションオブジェクト　または　配列のみ繰り返しを実行します　と出ます

入力は　数値で　mxmaker と同じ１～１７４までの数字　Split関数が文字列を返すのは見ましたが

テキストボックス３と４は数値でうまくいっているのに不思議です？
（K） 2017/03/27(月) 12:35

 「コンパイルエラー」ですよね？

  Dim k As Variant 　←　「k」が、本当にVariant型になっているか確認した方がいいと思います。

（半平太） 2017/03/27(月) 13:23

 このメッセージは文字通り、取り出す元ネタが　配列かコレクションオブジェクトではない場合にでます。

 Sub testNG()
    Dim k As Variant
    Dim km As Variant

    k = "abc"

    For Each km In k
        MsgBox km
    Next

 End Sub

 今回の場合は、k = Split(TextBox1.Value, ",") ですから、仮に　中身が ,　分割されていない
 １つだけの入力であっても、それは要素が１つだけの配列になりますので問題はありません。

 ただ、それは、『Windows』の場合の話であって、『Excel：Excel2012(Mac)、使用 OS：MacOSX 』の場合にどうなるのかは
 Macがないので、確認できません。

 ★エラーで止まった時に。

 ・表示　-> ローカルウィンドウ
 ・これで、でてきた画面の中の 変数 k の　『値』欄と　『型』欄　に何が記載されているか、教えてください。

（β） 2017/03/27(月) 16:38

 あのぉ・・・

 >テキストボックス１でのsplitで　型が合いませんと出ます
 >コンパイルエラーFor Each はコレクションオブジェクト　または　配列のみ繰り返しを実行します　と出ます

 エラーは、どちらだったんでしょうか？

（β） 2017/03/27(月) 17:31

（半平太）様
（β）様
ありがとうございます。

（β）様　コンパイルエラーでした　すみません

色々やってみたのですが　今度は　下記のコードで

For Each d In w

            .Cells(3, d + 7).Value = .Cells(3, d + 7).Value + 1
        Next
        End With

 .Cells　が無効か不完全ですと出ました

ローカルウインドウに入ると不具合が生じるのか　エクセルが終了します
一度Windowsでやってみます
（K） 2017/03/28(火) 08:03

すみません　また教えてください
試しに　上記コードを

 k = Split(TextBox1.Value, ",")
        For Each km In k  このkが反転して出ます
            If Not IsNumeric(km) Then
                erMsg = "数字で入力してください"
                erTxt = 1
            Else
                Select Case km
                    Case 1 To mxMaker
                    Case Else
                        erMsg = "1 から　" & mxMaker & " の数値で入力してください"
                        erTxt = 1
                End Select
            End If
            If erTxt = 1 Then Exit For
        Next With Sheets("Sheet1")For Each km In k
            .Cells(km + 4, 5).Value = .Cells(km + 4, 5).Value + 1
        Next
        End With
他を一度止めて　これだけ残して動かしてみました
うまくいきます
それで、テキストボックス３もテキストボックス１を止めて動かすと動きますが
二つをくっつけると　コンパイルエラーとなり前回と同じく　テキストボックス３の
.Cells のところが反転します
また　色々やっているうちに思ったのが　テキストボックスは４つも要らないのでは？
テキストボックス１とテキストボックス３があればいい様に思えるのですが
よろしくお願いします。
（k） 2017/04/08(土) 05:40

すみません

自己完結できました
（k） 2017/04/08(土) 06:31

コメント返信：

[ 一覧(最新更新順) ]

[[20170324050337]] 『アンケート結果』（K） ページの最後に飛ぶ

[[20170324050337]]　『アンケート結果』（K）　ページの最後に飛ぶ