リストボックス文字を連結しセルへ入力

質問

左上入力表にユーザーフォームリストボックスより選出実行された文字をB列にはリストボックス１の選出文字をC列にはリストボックス２、３、４から選出された文字を連ねて入力したいのですが。
尚、行に記入があれば次の空白から順に入力したい。
どなたかコードが解る方よろしくお願いします。

回答No.4

cj_mover · ベストアンサー

＃１、２、３、ｃｊです。
＃３補足欄へのレスです。

５つの大項目のうち、
　どの大項目を扱うべきなのか、
　対象となる大項目の先頭行は（絶対位置で）何行めなのか、
という情報を、私はどうすれば知ることができますか？
対象となる大項目の先頭行より下、最初に見つかる空セル、
が出力ポイントになる、ということのようですが、何分、起点が解りません。
そちらでは解るということでしたらば、

' ' ●（２／３択）●アクティブセルより下の行で、一番上にある空セル、に出力
　　Range("B" & ActiveCell.Row & ":B" & Rows.Count).SpecialCells(xlCellTypeBlanks).Areas(1)(1).Resize(, 2).Value = 氏名_項目()

この記述の
　ActiveCell.Row の部分を
　　対象となる大項目の先頭行の、（絶対位置での）行位置を
　　数値で
　指定して貰えればいいんだと思います。

実際には変数を使うなり工夫する必要はあるでしょうけれど
　対象となる大項目の先頭行の、（絶対位置での）行位置が
　10、であるならば、

　　Range("B" & 10 & ":B" & Rows.Count).SpecialCells(xlCellTypeBlanks).Areas(1)(1).Resize(, 2).Value = 氏名_項目()

という風に数値が当て嵌められるようにそちらで書き換えてみて下さい。

また、
　対象となる大項目の先頭行以下の３行（のＢ列）には必ず値が設定してある
　　（対象となる大項目の先頭行の、（絶対位置での）行位置が
　　　10、であるという例ならば、
　　　B10:B12 の範囲は必ず値が設定してある、という意味）
　ということならば、
上の記述をより簡単なものにして

　　Range("B" & 10).End(xlDown).Offset(1).Resize(, 2).Value = 氏名_項目()

のように書けるのかも知れません。

もっとも、
対象となる大項目と次なる大項目、の間に必ず空行がある、
という、大前提、で成り立つものですから、
対象となる大項目配下に出力するつもりが、次なる大項目配下になってしまう場合もあります。
大前提が崩れないように注意してください。

現状で私からアドバイス出来るのは、これ位のものです。

先々のこともあるので、またちょっと気になったことを書いておきます。
例えば、（本件と類似した例という意味で）
　２行めが項目タイトルで、
[番号]＿＿[氏名]＿＿[項目]
　と、なっていて、
　３行め以降データ
１＿＿"大分類"＿＿"hoge"
２＿＿"小分類"＿＿"piyo"
３＿＿"氏名１"＿＿"hogehoge"
４＿＿（空）＿＿（空）
５＿＿"大分類"＿＿"fuga"
６＿＿"小分類"＿＿"hogera"
７＿＿"氏名２"＿＿"fugapiyo"
８＿＿"氏名３"＿＿"piyopiyo"
９＿＿（空）＿＿（空）
10＿＿（空）＿＿（空）

　のような様式の表なんでしょうかね？

樹形図を二次元的に表した表、を編集するのは扱いが非常に難しいです。
将来的にお奨めしておきたいこととして、
【リレーショナルデータベース】について、さわりだけでも
知っておくと、色々な可能性や汎用性、融通性、などが見えてくると思います。
現在のような様式で表示したり印刷したりする必要があるにしても、
それは専ら表示用「レポート」にして、
入力作業や編集は別に「テーブル」を用意してそちらで行う
ようにシステムを作っておいた方が、すべての作業工程がシンプルになり
誰にも扱い易い、理解され易いものになると思います。

余談が過ぎたかも知れませんが、ご参考まで。

お礼

いろいろと親切丁寧に解答下さりありがとうございます。
おかげで思ったような処理が出来上がりました。
本当にありがとうございました。

回答No.3

cj_mover

＃１２、、ｃｊです。
＃２補足欄へのレスです。

よく解らないので、とりあえず３例挙げておきます。
添付画像（選択中のセル：Ｂ５）の例では、
赤い楕円で示したセル範囲が、上から順番に
以下の３例での出力先を示しています。
' ' ●（１／３択）●一番上にある空セル、に出力
' ' ●（２／３択）●アクティブセルより下の行で、一番上にある空セル、に出力
' ' ●（３／３択）●値が設定されたセルの中で一番下にあるセル、の、一つ下にある空セル、に出力　　←　＃１の内容
それぞれのコメントの下の行にコードがありますから、
必要なものを活かして、不要なものを削除してください。

■■
未入力項目がある場合、メッセージを表示して、何もせずに終了するように書き加えました。
この機能が無い方がよい場合は■■の行を削除してください。

■■■
リストボックスすべてを選択解除するプロシージャを書き加えました。
これによってユーザーフォームを表示したままの連続入力を可能にしました。
この機能が無い方がよい場合は■■■の行と■■■のプロシージャを削除してください。

★★
対象のシートを明示的に指定することを、便宜上、取り止めにしました。
アクティブなシートを対象に処理するように書きましたから、
ユーザーフォームをモードレス表示している場合などは注意してください。

MultiSelect プロパティについての状況が見えてきませんので、
いちいちMultiSelect プロパティを問い合わせて条件分岐するように書き直しました。
この点では（現状では不可避な）無駄が増えています。

' ' Userform モジュール
' ' Re8253740
Private Sub CommandButton1_Click() ' ★
　　Dim 氏名_項目(1 To 2) As Variant
　　Dim nLbNum As Long
　　Dim i As Long
　　Dim cn As Long ' ■■
　　Dim flg As Boolean ' ■■

　　氏名_項目(1) = ListBox1.Value ' ★

　　For nLbNum = 2 To 4
　　　　With Controls("ListBox" & nLbNum) ' ★
　　　　　　If .MultiSelect Then
　　　　　　　　flg = False ' ■■
　　　　　　　　For i = 0 To .ListCount - 1
　　　　　　　　　　If .Selected(i) Then
　　　　　　　　　　　　flg = True ' ■■
　　　　　　　　　　　　氏名_項目(2) = 氏名_項目(2) & .List(i)
　　　　　　　　　　End If
　　　　　　　　Next i
　　　　　　　　If flg Then cn = cn + 1 ' ■■
　　　　　　ElseIf .ListIndex > -1 Then
　　　　　　　　氏名_項目(2) = 氏名_項目(2) & .Value
　　　　　　　　cn = cn + 1 ' ■■
　　　　　　End If
　　　　End With
　　Next nLbNum

　　If IsNull(氏名_項目(1)) Then MsgBox "氏名未入力": Exit Sub
　　If cn < 3 Then MsgBox "未入力項目あり": Exit Sub ' ■■

' ' ●（１／３択）●一番上にある空セル、に出力
'　　Range("B2:B" & Rows.Count).SpecialCells(xlCellTypeBlanks).Areas(1)(1).Resize(, 2).Value = 氏名_項目()
' ' ●（２／３択）●アクティブセルより下の行で、一番上にある空セル、に出力
　　Range("B" & ActiveCell.Row & ":B" & Rows.Count).SpecialCells(xlCellTypeBlanks).Areas(1)(1).Resize(, 2).Value = 氏名_項目()
' ' ●（３／３択）●値が設定されたセルの中で一番下にあるセル、の、一つ下にある空セル、に出力
'　　Cells(Rows.Count, "B").End(xlUp).Offset(1).Resize(, 2).Value = 氏名_項目()

　　選択解除 ' ■■■
End Sub

Private Sub 選択解除() ' ■■■
　　Dim nLbNum As Long
　　Dim i As Long

　　For nLbNum = 1 To 4
　　　　With Controls("ListBox" & nLbNum) ' ★
　　　　　　If .MultiSelect Then
　　　　　　　　For i = 0 To .ListCount - 1
　　　　　　　　　　If .Selected(i) Then .Selected(i) = False
　　　　　　　　Next i
　　　　　　Else
　　　　　　　　.ListIndex = -1
　　　　　　End If
　　　　End With
　　Next nLbNum
End Sub

以上で、お求めの応えになっていたのなら、以下、読み進む必要はありません。
こちらの受け止め方と、質問者さんがやりたいことについての説明と、
どこですれ違ってしまっているのか、考えてもらえるように書きます。

最初のご質問で、
> 尚、行に記入があれば次の空白から順に入力したい。

この意味（"行"が何を指しているか）が未だによく解っていません。
もしかして、
　シート上のボタンを押すとユーザーフォームが表示される
　シート上で選択されている行について
　　未入力であれば、選択中の行の
　　既入力であれば、より下の行で、最初に見つかる未入力行の
　　　Ｂ、Ｃ列にデータを設定する
ということだったのかしら？という前提で今回のコードを試しに書いてみました。

それにしても、未入力行を、そのままにしておく理由が私にはよく解りません。
空行を挟んでいると、何をするにしても処理の手間数が増えてしまいますから、
一般的なExcelやVBAとの付き合い方で言えば、努めて空行を無くす方向で
上から順に入力するものなのではないでしょうか？
実際、空行を無くしてから処理を始めるマクロ、なんてオーダーも偶にありますが、
手作業で、ジャンプ機能（F5キー）、セル削除、セルの挿入、などの基本機能で
対応してからマクロを考えれば、訊ねるまでもない程簡単だったという話もよく耳にします。
漠然とした分類をする目的、等々で、何となく空行を挟む、
という使い方をする人がいるのは知っていますが、
それならそれで特殊な事情としてはっきり説明するようにした方が好いです。

＃２補足欄で
> コード入力で反映来たのですが文字が(B2,C2),(B5,C5),(B10,C10)に入力されていた場合B5,C5の行から順に入力する場合セル番号にてコード表示したいのですが。

総合的に、
　リストボックスの値をセル範囲に出力することについては望み通り出来たが、
　出力先のセルの位置について、
　　望み通りではなかった
　　または
　　考えているうちに要求仕様を改めた
ということなんだと思います。
　(B2,C2)・・・最初の添付画像ではタイトル行です。
　(B10,C10)・・・最初の添付画像では表の外です。
　B5,C5の行から順に入力する場合・・・これは、出力先のセルを、選択中の行を基準に選ぶ、という意味でしょうか？
　セル番号にてコード表示したいのですが・・・"セル番号"、"コード表示"ともに、何を指しているか解りません。
結局、どういう要求なのか未だ理解に至っていません。
あらためて補足頂ければと思っております。

お礼

誠にありがとうございます。

補足

誠にすみません。内容説明しますと表がありまして大項目が５項目に区切って範囲があり第２項目の小項目２行入力してありそれに続けて３行目から入力したくユーザーフォームもボタンにクリックにより５個呼出せます、貴殿の添付図で表すと10行目が第２の大項目とした場合B列に２行文字が入力されている場合３行目から入力したくCommandButton1_ClickによりコードにRange("B10")以降の空行からリストボックス選択値を入力したいのですが。よってセル値を指定してコード入力になると思いますが、何分説明がうまくなく申し訳ありませんがもし納得いただければご回答の方、よろしくお願いします。

回答No.2

cj_mover

＃１、ｃｊです。訂正。
誤）
オベジェクト名
正）
オブジェクト名
でした。
失礼しました。

お礼

ありがとうございます。

補足

コード入力で反映来たのですが文字が(B2,C2),(B5,C5),(B10,C10)に入力されていた場合B5,C5の行から順に入力する場合セル番号にてコード表示したいのですが。
尚、同様に行に記入があれば次の空白から順に入力したい。
誠に申し訳ありませんがご回答がもらえれば幸いです。

回答No.1

cj_mover

こんにちは。

' ★
リストボックス１、とか、リストボックス２、３、４、　とか、
実行？（のボタン）とか、
オベジェクト名が書いてないので、
それぞれ、デフォルト名で
ListBox1、ListBox2、ListBox3、ListBox4、
CommandButton1、
という仮定で書いています。

' ★★
また、こういう場合はシート名を明示したコードにした方が好いので
仮に"Sheet1"としています。

以上、それぞれ運用に合わせて適切な名前に書き換えてください。

リストボックス１については、
MultiSelect プロパティに、0 - fmMultiSelectSingle　を指定しておいてください。

リストボックス２、３、４、のMultiSelect プロパティは、すべて、
1 - fmMultiSelectMulti　という前提で書いています。
これらの中に、0 - fmMultiSelectSingle　を指定したリストボックスが混じっている場合、
特に障害を見つけることは出来ませんが、Microsoftが推奨するコードではなくなってしまいます。
実情（が判れば）に合わせて書き換える用意はあります。

シート上に配置された”入力”と書かれたボタンが、
ActiveXのコマンドボタン、である場合、且つ、このボタンでUserformを呼び出している場合は、
可能なら、コマンドボタンのTakeFocusOnClick プロパティをFalseに設定してください。

' ' Userform モジュール
' ' Re8253740
Private Sub CommandButton1_Click() ' ★
　　Dim 氏名_項目(1 To 2) As Variant
　　Dim nLbNum As Long
　　Dim i As Long

　　氏名_項目(1) = ListBox1.Value ' ★

　　For nLbNum = 2 To 4
　　　　With Controls("ListBox" & nLbNum) ' ★
　　　　　　For i = 0 To .ListCount - 1
　　　　　　　　If .Selected(i) Then 氏名_項目(2) = 氏名_項目(2) & .List(i)
　　　　　　Next i
　　　　End With
　　Next nLbNum

　　If IsNull(氏名_項目(1)) Then MsgBox "氏名未入力": Exit Sub

　　With Sheets("Sheet1") ' ★★
　　　　.Cells(Rows.Count, "B").End(xlUp).Offset(1).Resize(, 2).Value = 氏名_項目()
　　End With
End Sub