[[20150913073204]]　『ユーザーフォーム』（k）　ページの最後に飛ぶ

『ユーザーフォーム』（k）

ユーザーフォームでデーター記入をしています
Private Sub CommandButton1_Click()

    'アンケート番号数
    Const mxMaker As Long = 150
    Const mxReason As Long = 13
    Const mxAge As Long = 20
    '===========================
    Dim i As Long
    Dim k As Long
    Dim j As Long
    Dim h As Long
    Dim myRow As Long
    Dim erMsg As String
    Dim erTxt As Long
    Dim w As Variant
    Dim d 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のチェック
    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 + 8).Value = .Cells(k + 4, d + 8).Value + 1    '
        Next
        .Cells(k + 4, h + 8).Value = .Cells(k + 4, h + 8).Value + 1
    End With
    TextBox1.Value = ""
    TextBox2.Value = ""
    TextBox3.Value = ""
    TextBox4.Value = ""
    TextBox1.SetFocus
 End Sub

TextBox4の入力もTextBox3の様に複数入力できる様にコードを書き直したいのですが
宜しくお願いします

＜使用 Excel：unknown、使用 OS：MacOSX ＞

 erTxt １か所、未セットのところがあったので追加。(9/13 18:29)

 >TextBox4の入力もTextBox3の様に複数入力できる様にコードを書き直したいのですが

 TextBox3 でやっているように "," でSplitをして、それをチェックすればいいと思いますが？
 とうぜん、それら複数の値をシートに書きこむ必要がありますが、どこに、どう書きこみたいのかの説明がありませんので
 そこは別途の手当てが必要ですが。

 Dim w4 As Variant といったものを追加したうえで、

    'TestBox4のチェック
    If TextBox4.Value = "" Then
        erMsg = "年齢を入力してください"
        erTxt = 4
    Else
        w4 = Split(TextBox4.Value, ",")
        For Each d In w4
            If Not IsNumeric(d) Then
                erMsg = "年齢は数字で入力してください"
                erTxt = 4
                Exit For
            Else
                Select Case d
                    Case 1 To mxAge
                    Case Else
                        erMsg = "年齢は 15から　" & mxAge & " の数値で入力してください"
                        erTxt = 4
                        Exit For
                End Select
            End If
        Next
    End If

（β） 2015/09/13(日) 08:33

（β）様　お礼が遅くなりましたが

　思う結果が出ました

　ありがとうございました。
（k） 2015/09/14(月) 05:21

コメント返信：

[ 一覧(最新更新順) ]

[[20150913073204]] 『ユーザーフォーム』（k） ページの最後に飛ぶ

[[20150913073204]]　『ユーザーフォーム』（k）　ページの最後に飛ぶ