如何将列表框项添加到vba中的列？

Question

我有两个像图像一样的列表框。所以当列表框2完成后我单击“确定”时，列表框2中的数据应该被添加到A2到下一个范围。使用.AddItem在列表框1中填充数据 。

我试过这样：

Option Explicit

Private Sub BTN_moveAllLeft_Click()

    Dim iCtr As Long

    For iCtr = 0 To Me.ListBox2.ListCount - 1
        Me.ListBox1.AddItem Me.ListBox2.List(iCtr)
    Next iCtr

    Me.ListBox2.Clear
End Sub
Private Sub BTN_moveAllRight_Click()

    Dim iCtr As Long

    For iCtr = 0 To Me.ListBox1.ListCount - 1
        Me.ListBox2.AddItem Me.ListBox1.List(iCtr)
    Next iCtr

    Me.ListBox1.Clear
End Sub
Private Sub BTN_MoveSelectedLeft_Click()

    Dim iCtr As Long

    For iCtr = 0 To Me.ListBox2.ListCount - 1
        If Me.ListBox2.Selected(iCtr) = True Then
            Me.ListBox1.AddItem Me.ListBox2.List(iCtr)
        End If
    Next iCtr

    For iCtr = Me.ListBox2.ListCount - 1 To 0 Step -1
        If Me.ListBox2.Selected(iCtr) = True Then
            Me.ListBox2.RemoveItem iCtr
        End If
    Next iCtr

End Sub
Private Sub BTN_MoveSelectedRight_Click()

    Dim iCtr As Long

    For iCtr = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(iCtr) = True Then
            Me.ListBox2.AddItem Me.ListBox1.List(iCtr)
        End If
    Next iCtr

    For iCtr = Me.ListBox1.ListCount - 1 To 0 Step -1
        If Me.ListBox1.Selected(iCtr) = True Then
            Me.ListBox1.RemoveItem iCtr
        End If
    Next iCtr

End Sub

Private Sub cmdOK_Click()
Dim lngLastRow As Long
    Dim lngCol As Long
    Dim lngIndex As Long

    lngLastRow = Range("D" & Rows.Count).End(xlUp).Row + 1
    lngCol = 4
    For lngIndex = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(lngIndex) Then
            Cells(lngLastRow, lngCol) = ListBox2.List(lngIndex)
            lngCol = lngCol + 1
        End If
    Next
End Sub


Private Sub UserForm_Initialize()

    Dim iCtr As Long

    With Me.ListBox1
        For iCtr = 1 To 10
            .AddItem "This is a test" & iCtr
        Next iCtr
    End With

    Me.ListBox1.MultiSelect = fmMultiSelectMulti
    Me.ListBox2.MultiSelect = fmMultiSelectMulti

End Sub

Answer 1

如果要在范围A2中填充Listbox2中的数据，并在按下按钮OK后向下填充，请尝试以下操作：

Private Sub cmdOK_Click()
   Dim lngLastRow As Long
   Dim lngCol As Long
   Dim lngIndex As Long

   For lngIndex = 0 To ListBox2.ListCount - 1
      Cells(lngIndex + 2, 1).Value = ListBox2.List(lngIndex)
   Next
End Sub