[[20160927202913]] 『複数のテキストボックスからシートにカウントアッ』(フィロ) ページの最後に飛ぶ

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

 

『複数のテキストボックスからシートにカウントアップで反映させたい』(フィロ)

お世話になります。

実現したいことは明確にあるのですが、
検索ワードがイマイチのようでなかなか望む情報が得られませんので、
リンク等でもいいので教えて頂ければ助かります。

UserFormにて下記の作業を行いたいと考えてます。

1. ListBox1から値を選択 ( リストシート ( listDataの引数 ) をListBox1に反映 )
2. TextBox1に反映 ( TextBox1.Value = ListBox1.Value )
3. 同様の作業をListBox1からTextBox2, TextBox3, に反映
4. コマンドボタンにて、用意してあるシートへ反映。(カウントアップ)

現在は、ListBox1 , TextBox1ではこれを実現しております。
この場合ですと、複数項目を同時に入力したいときに面倒でして...。
下記が現在のコードになっております。

Private Sub UserForm_Initialize()

     ' DATAシートから各コンボボックスにデータを反映

    With Worksheets("DATA")

       cbKyaku.List = .Range("D2", .Range("D" & Rows.Count).End(xlUp)).Value
       cbTanto.List = .Range("E2", .Range("E" & Rows.Count).End(xlUp)).Value

    End With

 End Sub

Private Sub ListBox1_Change()

    ' ListBox1とtbNameの値を同期

    tbName.Value = ListBox1.Value

End Sub

Private Sub btnA_Click(): listData 1: End Sub 'ア
Private Sub btnKA_Click(): listData 2: End Sub 'カ
Private Sub btnSA_Click(): listData 3: End Sub 'サ
Private Sub btnTA_Click(): listData 4: End Sub 'タ
Private Sub btnNA_Click(): listData 5: End Sub 'ナ
Private Sub btnHA_Click(): listData 6: End Sub 'ハ
Private Sub btnMA_Click(): listData 7: End Sub 'マ
Private Sub btnYA_Click(): listData 8: End Sub 'ヤ
Private Sub btnRA_Click(): listData 9: End Sub 'ラ
Private Sub btnWA_Click(): listData 10: End Sub 'ワ
Private Sub btnStripe_Click(): tbName.Value = "STRIPE": End Sub
Private Sub btnBest_Click(): tbName.Value = "BEST OF THE BEST": End Sub
Private Sub btnSinki_Click(): tbName.Value = "新規": End Sub
Private Sub btnDay_Click(): tbHiduke = DateAdd("d", -1, Date): End Sub
Private Sub btnKokyaku_Click(): frmKokyaku.Show: End Sub

Sub listData(n As Integer)

    ' listData引数から顧客名をListBox1に反映

    ' 変数宣言
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long

    ' 顧客シートB列の最終行を取得後、ListBox1を初期化
    Set ws = Sheets("顧客")
    lastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row
    ListBox1.Clear

    For i = 5 To lastRow ' カウンタ変数を定義 (B列5行目〜最終行)

        If (ws.Range("H" & i).Value = n) Then ' 指定のコードがH列の値なら

          ListBox1.AddItem ws.Range("B" & i).Value ' ListBox1にB列値(5行〜最終行)顧客名を入力

        End If

    Next

End Sub

 Private Sub btnOk_Click()
    ' 売上シートに反映

    Dim lastRow As Long

    With Worksheets("売上")
        lastRow = .Cells(.Rows.Count, 7).End(xlUp).Row + 1

        .Cells(lastRow, 2) = Me.tbHiduke.Text
        .Cells(lastRow, 3) = Me.tbName.Text
        .Cells(lastRow, 4) = Me.cbKyaku.Text
        .Cells(lastRow, 5) = Me.tbPay.Text
        .Cells(lastRow, 6) = Me.tbBikou.Text
        .Cells(lastRow, 7) = Me.cbTanto.Text

    End With

    Unload Me '閉じる

End Sub

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 >>複数項目を同時に入力したいときに面倒でして

 複数項目を同時に入力 というのは 具体的にはどういうことですか?

 どこに なにを どんなかたちで入力し、それを、どこに反映させたいのですか?

(β) 2016/09/27(火) 20:58


ユーザーフォームに各項目を入力し実行後、Aシートに反映させるマクロになります。
その入力項目の1つに、Bシートから参照しているListBoxが存在します。
そのListBoxを選択後、同じユーザーフォーム内のTextBoxに値を代入させてます。
この一連の作業をListBoxから複数選択後、次々に用意しているTextBox2~10までに値を代入したいです。
説明が悪くすみません

(フィロ) 2016/09/27(火) 21:09


 つまり、複数選択可能なListBox で複数行選んで、CommandButonnクリック等のタイミングで
 TestBox1〜TextBox10 に 選ばれたものを、一挙に転記するということですか?

 もし、そうだとして、

 1.ListBox で 3つ選ばれた。

  この時、TestBox1,2,3 に転記、TextBox4〜TextBox10 をクリア

 2.ListBox で 15個 選ばれた

  ListBox で選ばれたものの中で最初の 10個のみ、TextBox1〜TextBox10 に転記。
  選ばれた 11個目〜15個目 は無視

 こういうことですか?

 それと、TextBoxへの転記は、ListBoxの上のほうから順番にということですか?

(β) 2016/09/27(火) 21:26


はい。そうです。
TextBoxへの転記は、ListBoxの上の方からなどは意識しておりませんでした。
この各TextBoxへの転記された値を実行ボタンなどを押下でAシートにカウントアップ?でどんどん入れたいという内容です。
(フィロ) 2016/09/27(火) 21:51

 βは、読解力と想像力がきわめてプアでして、仮に (β) 2016/09/27(火) 21:26 でコメントした理解に基づいて
 コードを書いて、回答していたら、なんじゃこれは! と突き返されるところでしたね。

 で、(フィロ) 2016/09/27(火) 21:51 のレスを読んでも、理解は一向に進みません。
 もし、この状態であれば、申し訳ありませんが、理解力に優れた回答者さんからの回答をお待ちください。

 >>下記が現在のコードになっております。

 ということですけど、コードからわかるのは、ListBox1 をクリックしたら 選ばれたものを tbName にセット。
 また、btnStripe 等をクリックしたら、それぞれのボタンで定められた固定文字列を tbName にセット。
 もう1つ、btnDay をクリックしたら、tbHiduke に何かセットされる。
 つまり、tbName や tbHiduke には、何かしらの操作で 何かが入るんだろうなと伺えますが、tbBikou 等は
 どうなんだろう? 操作者が入力するんだろうなぁ?

 と考えていくと、選んだものを『一挙に、どんどん』シートに追加していきたいというのが、具体的には
 どんなことなんだろう。そのイメージがわきません。

 たとえば 1つではなく 2つ 選択してシートに反映したい場合、現在の構えなら、ユーザーフォーム上で
 どんな操作をしていますか?

 操作1つ1つ、もれなく、流れを説明いただけませんか?

(β) 2016/09/28(水) 06:19


 連投失礼。

 そもそも、ListBoxから選んだものを TextBox に転記するということは、そこで打ち直すことも想定しているのでは?
 打ち直さないのであれば選んだものを直接、シートに追記すればいいわけですから。

 そうした時に、打ち直すという人間の操作が介入する、その流れを、自動化? 
 イメージが沸きません。

(β) 2016/09/28(水) 07:10


 もしかして・・・・

 1件選んで、必要ならTextBox上で打ち直し、btnOKクリックでシートに書きこむ。
 続けて、次にデータを選んで、同様にしてシートに書きこむ。
 このように【どんどん】追記していきたいが、更新のたびに ユーザーフォームが消えるので
 また立ち上げなければいけない。なんとかならないか。

 そういうことですか????

 であれば、更新後、btnOK の中で Unload Me '閉じる をしている、それを消せばいいだけなんですが?

(β) 2016/09/28(水) 08:02


βさん、少ししたら作業に入りますのですぐ返信させていただきます。
(フィロ) 2016/09/28(水) 11:09

それでは改めて説明させて頂きます。

[UserForm画像]
https://drive.google.com/open?id=0B0c0mM42PmivdmlRNGFzRkVKbEU

品種選択(ListBox)から目的の項目を複数選択後、右の商品フレーム内のTextBoxに上から順に転記したいです。
TextBox1に商品が入力されていればTextBox2に。というようにです。
入力後は、登録ボタンでシートに反映させたいです。

(β) 2016/09/28(水) 08:02 に関してですが、一度に複数のTextBoxの値を既存シートの最終行を取得し、反映させたい。です。
どうでしょう。。言葉では説明しづらいので画像をアップした次第です。

(フィロ) 2016/09/28(水) 13:23


 こういうことですか。

 新規ブックで、ユーザーフォームを準備。コントロールは ListBox1 と TextBox1〜TextBox10。
 ユーザーフォームを表示し、ListBox1からデータを【どんどん】選んでいってみてください。

 こういうことでよければ、あとは、このコード構成を、そちらのコードに反映させてください。

 Private Sub UserForm_Initialize()
    'ここはテストデータ作成部分なので無視してください。
    ListBox1.List = Array("A", "B", "C", "D", "E", "F")
 End Sub

 Private Sub ListBox1_Click()
    Dim x As Long
    Dim flg As Boolean

    For x = 1 To 10
        If Me.Controls("TextBox" & x).Value = "" Then
            Me.Controls("TextBox" & x).Value = ListBox1.Value
                flg = True
            Exit For
        End If
    Next

    If Not flg Then MsgBox "もう、満杯ですよ〜"

 End Sub

(β) 2016/09/28(水) 13:54


早速、置き換えてやってみます!

(フィロ) 2016/09/28(水) 14:05


無事に動作確認とれました。有難うございます!!
 ("TextBox" & x).Value
この意味が一段と理解出来たことが嬉しいです。
カウントアップとか的はずれな事いってすみませんです。

質問内容とは違いますが
下記のlistDataは抽象化出来るものなんでしょうか...

Private Sub btnA_Click(): listData 1: End Sub 'ア
Private Sub btnKA_Click(): listData 2: End Sub 'カ

(フィロ) 2016/09/28(水) 16:32


 btnA から btnWA までの 10個の処理のことですね。
 今でも十分に【汎用化】されていると思いますけど。

 無理やり、見かけ上、それぞれのボタンのクリックルーティンを書かないで1つにするということなら
 以下のような構成で書くことはできます。
 でも、βなら、そうしませんね。10個のボタンも用意しません。ListBoxに10個の情報をいれておいて
 そのクリックで処理しますね。

 でも、現在のボタン処理を活かしたいということなら。

 ●ユーザーフォームモジュール

 Option Explicit

 Dim btnPool As Collection

 Private Sub UserForm_Initialize()
    Dim cls As Class1
    Dim nm As Variant
    Dim x As Long

    Set btnPool = New Collection

    For x = 0 To 9
        Set cls = New Class1
        cls.init Me, Me.Controls(Array("btnA", "btnKA", "btnSA", "btnTA", "btnNA", "btnHA", "btnMA", "btnYA", "btnRA", "btnWA")(x)), _
                            Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)(x)
        btnPool.Add cls
    Next

    Set cls = Nothing

 End Sub

 ●クラスモジュール(Class1)

 Option Explicit

 Dim WithEvents objBtn As MSForms.CommandButton
 Dim myN As Long
 Dim objList As MSForms.ListBox

 Sub init(fm As MSForms.UserForm, btn As MSForms.CommandButton, n As Variant)
    Set objList = fm.Controls("ListBox1")
    Set objBtn = btn
    myN = n
 End Sub

 Private Sub objBtn_Click()
    Dim c As Range

    objList.Clear

    With Sheets("顧客")
        For Each c In .Range("B5", .Range("B" & Rows.Count).End(xlUp))
            If c.EntireRow.Range("H1").Value = myN Then objList.AddItem c.Value
        Next
    End With

 End Sub

(β) 2016/09/28(水) 18:03


 ListBox案もアップしておきます。コードは非常に短く、シンプルになります。

 ListBox を1つ追加。以下コードでは名前を ListTable にしています。
 で、どのシートのどの領域でもいいのですが、2列のテーブル(現在の仕様では10行)を準備します。
 1列目は、何を抽出するかの説明、2列目は抽出時の比較条件(1,2,3.。。)
 この領域に、名前を付けます。以下コードでは 「Table」という名前にしています。
 このシートは非表示でも構いません。将来、抽出対象が増えれば、追加すればコードは変更不要。
 (ただし、追加時、その部分も Table という名前の領域に含まれるように名前の登録変更が必要ですが)

 クラスモジュールは不要です。
 ユーザーモジュールは以下のみ。ListTableで選択すれば、現在の btnA や bntWA をクリックした処理が行われます。

 Option Explicit

 Private Sub UserForm_Initialize()
    With ListTable
        .ListStyle = fmListStyleOption
        .List = Range("Table").Value
    End With
 End Sub

 Private Sub ListTable_Click()
    Dim c As Range

    ListBox1.Clear

    With Sheets("顧客")
        For Each c In .Range("B5", .Range("B" & Rows.Count).End(xlUp))
            If c.EntireRow.Range("H1").Value = ListTable.List(ListTable.ListIndex, 1) Then ListBox1.AddItem c.Value
        Next
    End With

 End Sub

(β) 2016/09/28(水) 18:57


ListBox案 素晴らしいですね。有難うございます。
とても参考になります。

今は、TextBox1~10の内、入力があるTextBoxのみをシートに反映させるのに苦戦中です。笑
けれども、まずは自分でやってみたいと思います!
(フィロ) 2016/09/28(水) 20:29


どうしても上手く機能しないので連投させていただきます。

UserForm 各項目を入力後、OKボタン押下で、シートに反映になるのですが、未入力のTextBoxの空白が入り
TextBoxの個数分 空白行が入ります。今は10行です。
単純に入力されているTextBoxをシートに反映したいです。
Else で何か処理しなければいけないのかな?と思っております。

Private Sub btnOk_Click()

    Dim lastRow As Long
    Dim x As Long

    For x = 1 To 10

        With Worksheets("仕入")
            lastRow = .Cells(.Rows.Count, 8).End(xlUp).Row + 1

        If Me.Controls("TextBox" & x).Value <> "" Then
            .Cells(lastRow, 4) = Me.Controls("TextBox" & x).Text

        End If

            .Cells(lastRow, 2) = Me.tbHiduke.Text
            .Cells(lastRow, 3) = Me.cbShiire.Text
            .Cells(lastRow, 8) = Me.cbTanto.Text

        End With
    Next

    Unload Me '閉じる
End Sub
(フィロ) 2016/09/28(水) 23:18

 たとえば以下。With の場所、結果オーライですけど適切ではないので変えてあります。
 (ループのたびにWithでくくる必要はない)

 Private Sub btnOk_Click()

    Dim lastRow As Long
    Dim x As Long

    With Worksheets("仕入")

        lastRow = .Cells(.Rows.Count, 8).End(xlUp).Row

        For x = 1 To 10
            If Me.Controls("TextBox" & x).Value <> "" Then
                lastRow = lastRow + 1
                .Cells(lastRow, 4) = Me.Controls("TextBox" & x).Text
                .Cells(lastRow, 2) = Me.tbHiduke.Text
                .Cells(lastRow, 3) = Me.cbShiire.Text
                .Cells(lastRow, 8) = Me.cbTanto.Text
            End If
        Next

    End With

    Unload Me '閉じる

 End Sub

(β) 2016/09/28(水) 23:47


βさん、有難うございます。
問題なく機能します!
(フィロ) 2016/09/29(木) 14:47

βさんのお陰により下記のコードも実装出来ました。
とってもスッキリして何より理解出来てる自分が楽しいです。

Private Sub UserForm_Initialize()

     ' DATAシートから各コンボボックスにデータを反映
    Dim x As Long

    With Worksheets("DATA")

        For x = 1 To 10
            Me.Controls("cb" & x).List = .Range("D2", .Range("D" & Rows.Count).End(xlUp)).Value
            cbShiire.List = .Range("H2", .Range("H" & Rows.Count).End(xlUp)).Value
            cbTanto.List = .Range("E2", .Range("E" & Rows.Count).End(xlUp)).Value
        Next

    End With

End Sub

(フィロ) 2016/09/29(木) 14:57


コメント返信:

[ 一覧(最新更新順) ]


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