こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

複数選択可能なリストボックス

Excel VBAの質問をさせてください。
シート(sheet1)のA列、セルA1から以下のデータがあるとします。
みかん
りんご
バナナ


バナナ
バナナ
みかん

フォームのリストボックスで"みかん"と"バナナ"を選択した際、シート(sheet2)のセルA1にコピーしていきたいのですが機能しません。
単品、"みかん"だけを選択しても何もコピーされません。
どこがいけないでしょうか??

Private Sub UserForm_Initialize()
  With ListBox1
    .AddItem "みかん"
    .AddItem "りんご"
    .AddItem "バナナ"
    .AddItem "苺"
    .AddItem "梨"
.MultiSelect = fmMultiSelectMulti
  End With
End Sub

Private Sub CommandButton1_Click()

Dim i As Long
For i = 1 To 8

If Worksheets("Sheet1").Cells(i, "A").Value = Me.ListBox1.Value Then

Worksheets("Sheet1").Cells(i, "A").Copy Worksheets("Sheet2").Cells(i, "A")

End If

End Sub

投稿日時 - 2016-10-19 13:57:48

QNo.9244809

困ってます

質問者が選んだベストアンサー

こんにちは
昨日の回答が全てですけど?
MultiSelect = fmMultiSelectMulti で複数選択可能にされているので、
If Worksheets("Sheet1").Cells(i, "A").Value = Me.ListBox1.Value Then
は使えないです。
Me.ListBox1.Value がエラーになるはずです。

投稿日時 - 2016-10-20 07:56:41

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.1

こんにちは
複数選択可能にしているので、何が選択されているか調べないとダメです。
Private Sub CommandButton1_Click()
  Dim i As Long
  Dim j As Long
  Dim v()
  Dim x As Variant
  For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) = True Then
      ReDim Preserve v(i)
      v(i) = CStr(Me.ListBox1.List(i))
    End If
  Next
  For i = 1 To 8
    x = Application.Match(Worksheets("Sheet1").Cells(i, "A").Value, v, 0)
    If Not IsError(x) Then
      j = j + 1
      Worksheets("Sheet1").Cells(i, "A").Copy Worksheets("Sheet2").Cells(j, "A")
    End If
  Next
End Sub
同じデータも全部コピーするのでしょうか?
要件が良く分かりませんけど・・・

投稿日時 - 2016-10-19 14:37:59

補足

同じデータもすべてコピーしていきます。
ありがとうございます。

大変申し訳ございませんが、他にもリストボックスがございまして、まず今回の↓条件を入れたいのですが
いただいたサンプルのどこの箇所でいれるのが適切でしょうか
いろいろ試しましたがうまくいきませんでした。

If Worksheets("Sheet1").Cells(i, "A").Value = Me.ListBox1.Value Then
.
End if

投稿日時 - 2016-10-19 20:18:26

あなたにオススメの質問