Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(指定なし : Excel 2013)
リストボックスとコマンドボタン
投稿日時: 18/10/12 15:08:34
投稿者: 321rsan

VBA初心者です。
Aさん、Bさん...Eさんの中から複数選択できるリストボックスを作り、コマンドボタンを押すと指定セルに反映されるユーザーフォームを作ったのですが、一つ目のセルでリストを選びボタンを押すとユーザーフォームを設定した全部のセルに値が反映されてしまいます。
Privets Sub CommandButton1_Click()
      Dim i As Interger, s As string
       For i = 0 to ListBox1.ListCount -1
              If ListBox1.Selected(i) Then
                  s = s & ListBox1.List(i)
              End If
       Next
         Range(“i6:i85).Value= s
End Sub
Rangeがおかしいのかと思っているのですが、全部最初から変えた方がいいのかわからなくて困っています。
言葉足らずでかなり分かりづらいと思いますが、よろしくお願いします。
 

投稿日時: 18/10/12 15:20:25
投稿者: 321rsan

i6からi85までダブルクリックするとユーザーフォームがでるようにワークシートにコードを記入していますが、どのセルでリストを選択してもi6からi85までまとめて変わってしまいます。
これを各セルごとに反映するようにしたいです。

回答
投稿日時: 18/10/12 17:28:41
投稿者: Suzu

代入している部分は
 
 Range(“i6:i85).Value= s
 
ですよね。(ダブルクオーテーションが全角だったり、後半にないのはおいておいて)
 
ここで、代入先に、セルの、 I6:I85 を指定していますから 当然、その I6:I85 に s の値が入ります。
 
ここを、選択されているセルにすれば良いです。
 
「選択されている」というのは、Excelには便利な Selection というのがありますね。

回答
投稿日時: 18/10/12 17:34:23
投稿者: WinArrow
投稿者のウェブサイトに移動

>全部のセルに値が反映されてしまいます。
  
原因は、↓ 全部を文字列で結合しているから
> s = s & ListBox1.List(i)
   
「s」のデータ定義が文字列になっていますが、
セルに格納することを目的とするならば、2次元配列にしてください。
 
いか、サンプルコードです。
  
Private Sub CommandButton1_Click()
Dim i As Integer, scnt As Long, s
    scnt = 0
    ReDim s(1 To 1, 1 To 1)
    For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) Then
            scnt = scnt + 1
            ReDim Preserve s(1 To 1, 1 To scnt)
            s(1, scnt) = Me.ListBox1.List(i)
        End If
    Next
    If UBound(s, 2) Then
       ReDim Preserve s(1 To 1, 1 To scnt + 1)
    End If
    s = WorksheetFunction.Transpose(s)
    Range("I6").Resize(scnt).Value = s
End Sub
 
※掲示板にコードを掲示する場合は、コードペインからコピペしましょう。
掲示板に手入力して、入力ミス等があると本題ではないところでキャッチボールが始まります。

回答
投稿日時: 18/10/12 20:54:14
投稿者: WinArrow
投稿者のウェブサイトに移動

コードの一部修正
 
> If UBound(s, 2) Then
> ReDim Preserve s(1 To 1, 1 To scnt + 1)
> End If

    If UBound(s, 2) = 1 Then
        ReDim Preserve s(1 To 1, 1 To scnt + 1)
     End If

投稿日時: 18/10/15 09:37:06
投稿者: 321rsan

無事思っていたようなExcel表を作る事が出来ました!
コメントくださった方々本当にありがとうございました!