将项目从一个列表框移动到另一个列表框而不重复

Question

我有一个带有两个列表框的用户表单。我希望左侧列表框包含大量项目，用户可以选择他们想要的项目并将它们发送到右侧的列表框中。这不会从左侧的列表框中删除项目。左边的项目是唯一的。

我不希望用户能够将相同的项目两次发送到右侧列表，所以我有以下子项来检查重复项：

Sub ToRight(ctrlLeft As control, ctrlRight As control)
    Dim i As Integer, j As Integer
    Dim there As Boolean

    For i = 0 To ctrlLeft.ListCount - 1
        If ctrlLeft.Selected(i) = True Then
                there = False
                For j = 0 To ctrlRight.ListCount - 1
                    If ctrlRight.List(j) = ctrlLeft.List(i) Then
                        there = True
                    End If
                Next
                If there = False Then ctrlRight.addItem ctrlLeft.List(i)
        End If
    Next
End Sub

对于左侧列表框中的每个选定项目，它将检查右侧列表框中的每个项目以查看是否存在匹配项，并且仅在没有匹配项时才添加该项目。一旦列表中有大约1000个条目（可能发生），并且运行代码后用户窗体实际隐藏自身（5秒），这非常慢。我必须最小化并重新最大化Excel应用程序，以便再次显示userform（并且它是模态的）。

如何在没有如此痛苦的循环的情况下将项目发送到正确的列表框？或者我怎样才能使循环更便宜，以免崩溃用户形式？

Answer 1

脚本字典非常适​​合比较多个列表。

Private Sub btnCopyUniqueSelectedItems_Click()

    Dim i As Integer
    Dim dictItems As Object
    Set dictItems = CreateObject("Scripting.Dictionary")

    For i = 0 To ctrlRight.ListCount - 1

        dictItems.Add ctrlRight.List(i), vbNullString

    Next

    For i = 0 To ctrlLeft.ListCount - 1
        If ctrlLeft.Selected(i) = True And Not dictItems.Exists(ctrlLeft.List(i)) Then

            ctrlRight.AddItem ctrlLeft.List(i)

        End If
    Next

End Sub

Answer 2

使用更简单更快的循环，我制作了一个如下图所示的模板。我在 ListBox1 上列出了工作表的列标题。使用 按钮将 ListBox1 中的选定项移动到 ListBox2。 ListBox2 上的项目所指向的列被复制到另一个工作表。

If ListBox1.ListIndex = -1 Then
MsgBox "Choose an listbox item from left", , ""
Exit Sub
End If

deg = ListBox1.Value
    For m = 0 To ListBox2.ListCount - 1
    If deg = CStr(ListBox2.List(m)) Then
        MsgBox "This item already exists in ListBox2", vbCritical, ""
    Exit Sub
    End If
Next
ListBox2.ListIndex = -1
 ListBox2.AddItem ListBox1.Value
ListBox1.RemoveItem (ListBox1.ListIndex)
Call animation_to_right

Template can be viewed and downloaded here