[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『アンケート結果』(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.