在列表框之间添加和删除项目

Add and Remove items between List Boxes

我正在尝试在我的用户窗体上的两个列表框之间实现管理和交换 "items"。 IE。我在 ListBox1 中有项目(我使用 multi-select),然后单击 "Add" 命令按钮,所有项目都添加到 ListBox2。 - 那段代码有效。我还可以根据 selection 或 "Clear All" 命令按钮从 ListBox2 中删除项目。

当我将 "Remove" 命令按钮使用的类似代码添加到 "Add" 命令按钮时,出现错误。我的目标是从 ListBox1 中删除项目,这样我就不会在 ListBox2 中重新添加或复制它们。错误是 "Run-time error'- 2147467259(80004005)': Unspecified error".

我已经将问题缩小到一个来源,但我不知道如何解决它。问题是我填充 ListBox1 的方式。目前,我使用命名范围填充 ListBox1,此命名范围指的是 table.

中的列
MyUserForm.ListBox1.RowSource = "ListOfItems"

如果我使用下面的代码,我不会得到同样的错误并且一切正常。

With MyUserForm.ListBox1.
   .AddItem "Item 1"
   .AddItem "Item 2"
   .AddItem "Item 3"
   .AddItem "Item 4"
End With

我真的很想坚持填充 ListBox1 的第一个 "method",因为命名范围是动态的并且经常更改。

这是有效的代码。我使用此代码将 "Add" 个项目添加到 ListBox2(我已对代码行进行编号以便于参考):

(1)For i = 0 To LIstBox1.ListCount - 1
(2)   If ListBox1.Selected(i) = True Then
(3)       ListBox2.AddItem ListBox1.List(i)
(4)    End If
(5)Next

这是我用来从 LitBox1 中删除已添加到 ListBox2 的项目的代码:

(6)For i = ListBox1.ListCount - 1 To 0 Step -1
(7)    If ListBox1.Selected(i) = True Then
(8)        ListBox1.Selected(i) = False
(9)        ListBox1.RemoveItem (i)
(10)    End If
(11)Next

点击debug出现第(9)行出现上述错误。我试过有和没有第 8 行的代码,但没有成功。

任何帮助将不胜感激。

抱歉看起来 post,我认为提供更多细节总比提供太少要好。

尝试通过遍历命名范围来填充您的列表框。我认为这可以让它保持动态,但一次添加一个东西。

For each entry in sheet1.range("ListOfItems") 'adjust sheet as necessary
    MyUserForm.ListBox1.AddItem entry
next

不要为 ListBox1 设置 RowSource 属性,而是通过在 UserForm 初始化事件期间循环遍历 ListOfItems 范围来添加项目,如下所示...

Private Sub UserForm_Initialize()
Dim cell As Range
With Me.ListBox1
    For Each cell In Range("ListOfItems")
        .AddItem cell
    Next cell
End With
End Sub

然后在用于将所选项目添加到 ListBox2 的命令按钮(示例代码中名为 AddItem)下方,放置以下代码...

Private Sub AddItem_Click()
Dim i As Long
With Me.ListBox1
    For i = 0 To .ListCount - 1
        If .Selected(i) Then
            Me.ListBox2.AddItem .List(i)
        End If
    Next i
    For i = .ListCount - 1 To 0 Step -1
        If .Selected(i) Then
            .RemoveItem i
        End If
    Next i
End With
End Sub