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

【问题标题】：Move items from one listbox to another without duplicating将项目从一个列表框移动到另一个列表框而不重复
【发布时间】：2016-08-11 13:47:17
【问题描述】：

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

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

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 应用程序才能再次显示用户窗体（它是模态的）。

如何在没有如此痛苦的循环的情况下将项目发送到正确的列表框？或者我怎样才能使循环更便宜，这样它就不会导致用户表单崩溃？

【问题讨论】：

当你将它移动到右边的列表框时，从左边移除它，反之亦然，这样他们就不能两次添加相同的项目。就这么简单:)
@SiddharthRout 我曾想过这样做，但是这些项目是根据我们的命名法排序的，这个顺序有一定的意义，用户会希望按照这个顺序看到列出的项目。如果我将它从左侧列表中删除，并且用户决定他们根本不想拥有该项目，则将其发送回左侧会将订单放在末尾span>
如果你能解释一下这个顺序，也许我们可以把它放回原来的位置？
或者你可以在项目前加上1., 2. 3. 这样你就知道它属于哪个位置了？
查看我之前的评论。您可以添加前缀或将列表存储在隐藏的工作表中。列表将在 B 列，位置将在 A 列。因此，当用户将其移回时，只需检查隐藏表中的位置；）

标签： vba excel listbox

【解决方案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

【讨论】：

【解决方案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

【讨论】：