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

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『アンケート結果』(K)

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

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+4を3にしてみたのですが
1度目はいきますが足し算ができませんでした
 .Cells(k + 4, h + 7).Value = .Cells(k + 4, h + 7).Value + 1 ここも同じです

3行目               来店動機 1 2 3 〜15 年齢15〜21
                                     

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

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

< 使用 Excel:Excel2012(Mac)、使用 OS:MacOSX >


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

 >メーカー(テキストボックス1)ナンバーも複数 数量も(テキストボックス2)複数 打てる様にしたいのですが 

 過去トピ

[[20150913073204]] 『ユーザーフォーム』(k)

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

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

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

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

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

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


申し訳ありません

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


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

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

テキストボックス1での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 と同じ1〜174までの数字 Split関数が文字列を返すのは見ましたが

テキストボックス3と4は数値でうまくいっているのに不思議です?
(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, ",") ですから、仮に 中身が , 分割されていない
 1つだけの入力であっても、それは要素が1つだけの配列になりますので問題はありません。

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

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

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

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


 あのぉ・・・

 >テキストボックス1での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
他を一度止めて これだけ残して動かしてみました
うまくいきます
それで、テキストボックス3もテキストボックス1を止めて動かすと動きますが
二つをくっつけると コンパイルエラーとなり前回と同じく テキストボックス3の
.Cells のところが反転します
また 色々やっているうちに思ったのが テキストボックスは4つも要らないのでは?
テキストボックス1とテキストボックス3があればいい様に思えるのですが
よろしくお願いします。
(k) 2017/04/08(土) 05:40

すみません

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


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.