各ボックスの値を、指定セルに転記したいのですが

質問

エクセル2007で作成

・入力シートでユーザーフォーム１を呼出す。
B列の最終行をアクティブセルとする

・コンボボックス1にて部署名を選択。

・コンボボックス2にて個人名を選択。
Sub ComboBox2_Click()
Dim lastRow As Long
Dim myLlist As String
Dim R As Long
myLlist = ComboBox2
With UserForm1
Select Case myLlist
Case "○○　△△"　’個人名
.ListBox1.RowSource = "○○!B1:B100"　←B100ではなく、最終行に変更したい
End Select
End With
End Sub

・リストボックス1にて作業名を選択（複数可）後、決定コマンドボタンにて確定。
　入力シートのアクティブセルにコンボボックス1の値を転記
　右隣セルにコンボボックス2の値を転記
　さらに右隣にリストボックス1の値を転記
Sub 決定_Click()
ActiveSheet.Unprotect
Dim 行 As Long
Dim 列 As Long
Dim i As Integer
Dim LB As String
With UserForm1
行 = ActiveCell.Row
列 = ActiveCell.Column
UserForm1.ComboBox1.Value = Cells(行, 列)
UserForm1.ComboBox2.Value = Cells(行, 列 + 1)
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
LB = LB & .List(i, 0)
LB = Cells(行, 列 + 2)　←ココを変更したい
End If
Next i
End With
End With
End Sub

個人名シートの指定範囲は、最終行までとしたい。
転記後、Ｄ列の１セルの中に選択した複数の作業名が入ってしまうので、
作業名単位で行を分けたい。
その時、同一部署なら同名をＢ列の下の行に、
同一人物なら同名もＣ列の下の行に転記したい。

以上、行いたい事項です。
方法がわからず困っています。
どなたかご教授頂きますよう、宜しくお願い致します。

回答No.3

watabe007 · ベストアンサー

>仮にアクティブセルがB10であった時にリストボックス1で5つ選択された場合、
>コンボボックス1の値はB10からB14に
>コンボボックス2の値はC10からC14に
>リストボックス1の値はD10からD14に
>それぞれ入力させたいのですが・・・

　　↑このような情報は先に言っておいてくださいね。

　　For i = 0 To .ListCount - 1
　　　　If .Selected(i) = True Then
　　　　　　ActiveCell.Offset(j, 0).Value = Me.ComboBox1.Value
　　　　　　ActiveCell.Offset(j, 1).Value = Me.ComboBox2.Value
　　　　　　ActiveCell.Offset(j, 2).Value = .List(i, 0)
　　　　　　j = j + 1
　　　　End If
　　Next

お礼

watabe007様

説明不足で度々ご面倒お掛けして、申し訳ございませんでした。
完璧です!!!
また、次回質問時にも助けて頂ければ、助かります。
それまでにもっとレベルアップ出来るよう、勉強します。
お世話になりました。
ありがとうございました。

回答No.2

watabe007

>リストボックス1の転記ですが、複数選択をしても
>複数行へ転記出来ず同一セル内に入ってしまいます。
>解消したいので、引続きご検討の程よろしくお願いします。

あなたがアップされたコード
>For i = 0 To .ListCount - 1
>If .Selected(i) = True Then
>LB = LB & .List(i, 0)
>LB = Cells(行, 列 + 2)　←ココを変更したい
>End If
>Next i

を見る限りは、それぞれの選択された値を連結して
>さらに右隣にリストボックス1の値を転記
と思われますが・・・

>さらに右隣にリストボックス1の値を転記
では２つ目のリストボックスの値は、どこに？
さらに右隣のセルから下に続けるのなら
　　For i = 0 To .ListCount - 1
　　　　If .Selected(i) = True Then
　　　　　　ActiveCell.Offset(j, 2).Value = .List(i, 0)
　　　　　　j = j + 1
　　　　End If
　　Next

お礼

再度の回答、ありがとうございます。
イメージ通りです。

が、コンボボックス1と2の値をリストボックス1で選択した数だけ
下に入力出来れば完成です。

仮にアクティブセルがB10であった時に
リストボックス1で5つ選択された場合、
コンボボックス1の値はB10からB14に
コンボボックス2の値はC10からC14に
リストボックス1の値はD10からD14に
それぞれ入力させたいのですが・・・

あと一息ですので、引き続き宜しくお願い致します。

回答No.1

watabe007

>個人名シートの指定範囲は、最終行までとしたい。
>ListBox1.RowSource = "○○!B1:B100"　←B100ではなく、最終行に変更したい

Dim strRow As String

With Sheets("○○")
　　strRow = .Range("B1", .Cells(Rows.Count, "B").End(xlUp)).Address(External:=True)
End With
.ListBox1.RowSource = strRow

>入力シートのアクティブセルにコンボボックス1の値を転記
>UserForm1.ComboBox1.Value = Cells(行, 列)
ActiveCell.Value = UserForm1.ComboBox1.Value

>右隣セルにコンボボックス2の値を転記
>UserForm1.ComboBox2.Value = Cells(行, 列 + 1)
ActiveCell.Offset(, 1).Value =UserForm1.ComboBox2.Value

>さらに右隣にリストボックス1の値を転記
>For i = 0 To .ListCount - 1
>　　If .Selected(i) = True Then
>　　　　LB = LB & .List(i, 0)
>　　　　LB = Cells(行, 列 + 2) '←ココを変更したい
>　　End If
>Next i
For i = 0 To .ListCount - 1
　　If .Selected(i) = True Then
　　　　LB = LB & .List(i, 0)
　　End If
Next i
ActiveCell.Offset(, 2).Value =LB

お礼

watabe007様
回答、ありがとうございます！

補足

watabe007様

早々の回答、ありがとうございます。
出張の為挨拶が遅くなり、申し訳ございませんでした。

リストボックス1の転記ですが、複数選択をしても
複数行へ転記出来ず
同一セル内に入ってしまいます。
解消したいので、引続きご検討の程よろしくお願いします。