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

質問

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

回答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