限制可以从一个列表框移动到另一个列表框的项目数

时间:2015-12-21 22:43:01

标签: excel-vba vba excel

我想将Listbox1中的8个选定项目移动到Listbox2。两个列表框都是多选的。当我选择8个以上的项目并将它们一次移动到Listbox2时,这些项目不会从Listbox1中删除。但是,当我单独移动项目时,项目将从Listbox1中删除,但项目编号8除外。

如果我不试图限制可以移动的项目数量但是我很难让它使用指定的条件(Listbox2中只有8个项目),代码很有效。

我环顾四周但找不到一个好例子。我真的很感激建议。我也想知道我想做的事情是不可能的。

    Private Sub BTN_MoveSelectedRight_Click()

    Dim iCtr As Long

        For iCtr = 0 To Me.ListBox1.ListCount - 1


            If Me.ListBox1.Selected(iCtr) = True And Not ListBox2.ListCount = 8 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 And Not ListBox2.ListCount = 8 Then
                Me.ListBox1.RemoveItem iCtr

            End If
        Next iCtr


End Sub

2 个答案:

答案 0 :(得分:1)

ListBox.ListCount会返回Listox中的项目数。如果您想获得所选项目的数量,那么您需要这种功能:

Private Function SelectedCount(lbox As msforms.ListBox) As Integer
    Dim i As Integer
    Dim sel As Integer

    For i = 0 To lbox.ListCount - 1
        If lbox.Selected(i) Then sel = sel + 1
    Next

    SelectedCount = sel
End Function

如果您愿意,可以跟踪选择,每当用户选择第九项时,请取消选择最旧的项目。这样,您的ListBox将始终拥有八个(或更少)最近选择的项目。你可以这样做:

Option Explicit
Private mEnableUserEvents As Boolean
Private mSelectionOrder As Collection
Private Sub ListBox1_Change()
    Dim key As String

    If Not mEnableUserEvents Then Exit Sub
    key = CStr(ListBox1.ListIndex)
    If ListBox1.Selected(ListBox1.ListIndex) Then
        mSelectionOrder.Add ListBox1.ListIndex, CStr(ListBox1.ListIndex)
        If mSelectionOrder.Count = 9 Then
            mEnableUserEvents = False
            ListBox1.Selected(mSelectionOrder.Item(1)) = False
            mEnableUserEvents = True
            mSelectionOrder.Remove 1
        End If
    Else
        mSelectionOrder.Remove key
    End If
End Sub

Private Sub UserForm_Initialize()
    mEnableUserEvents = True
    Set mSelectionOrder = New Collection
End Sub

答案 1 :(得分:0)

此代码会将前4个选定项目从listbox1移至listbox2,如果listbox2有8个项目将无效,我不知道这是否是您所需要的。

Private Sub BTN_MoveSelectedRight_Click()
   Dim iCtr As Long
   Dim i As Long
   Dim j As Long
   Dim arr(8) As Long

        For iCtr = 0 To Me.ListBox1.ListCount - 1

            If Me.ListBox1.Selected(iCtr) = True And Not ListBox2.ListCount = 8 Then
                Me.ListBox2.AddItem Me.ListBox1.List(iCtr)

                arr(i) = iCtr
                i = i + 1
            End If

          If i = 8 Then Exit For
        Next iCtr

        For j = i - 1 To 0 Step -1
         Me.ListBox1.RemoveItem arr(j)
        Next
End Sub