vba excel - 在一个命令中传输MultiSelect ListBox项和SingleSelect项

Question

我有2个相邻的列表框来回传输项目。每个列表框都有一个相应的工作表。在每个列表框和每个工作表之间，每个选择从第一个项目向下传输到最后一个项目。如果选择ListBox中的最后一项以转移到其相邻列表框，则该项目将转移到其相邻列表（和工作表），但其原始列表（和工作表数据）的其余部分将消失（更新： 只有在SingleSelect Property使用MultiSelect代码时才。我想知道是否有人可以在代码中看到我明显忽略的东西。以下是我的转帐代码。

编辑： ListBox1 是 MultiSelect ， ListBox2 是 SingleSelect ，该代码仅用于 MultiSelect ListBoxes。我的工作示例（即ListBox1属性）没有考虑到这一点，所以我更新了下面的代码，以反映 MultiSelect 和 SingleSelect ListBoxes之间的转移。我知道这个简单的程序有很多代码，但这对我的应用程序来说是必需的，所以我希望这可以帮助别人。

经过测试并正常工作。

Private Sub MultiListToSingleList()
    Set ws = Sheets(1)
    With ListBox2 'SingleSelect ListBox
        .ColumnCount = 7
        .ColumnWidths = "0;0;150;20;0;0;0" 'contains different columns and 
    End with                               'indexing than ListBox1
' can insert error handling and message boxes here
    With ListBox1
        For n = 0 To .ListCount - 1
            If .Selected(n) Then
                With ListBox2
                    .AddItem Me.ListBox1.List(n)
                    .List(ListBox2.ListCount - 1, 2) = ListBox1.List(n, 1)
                    .List(ListBox2.ListCount - 1, 3) = ListBox1.List(n, 2)
                End With
            End If
        Next n
        For n = .ListCount - 1 To 0 Step -1
            If .Selected(n) Then
                .RemoveItem n 'removes the item from ListBox1
                ws.Rows(n + 2).EntireRow.Delete 'removes the row from the 
            End if                              'ListBox1 source in Sheet 1
        Next n
    End With
    SheetTransfer
End Sub

Private Sub SingleListToMultiList ()
    Set ws = Sheets(2)
    With ListBox1 'MultiSelect ListBox
        .ColumnCount = 3
        .ColumnWidths = "0;140;20"
    End With
' can insert error handling and message boxes here
    With ws
        With ListBox2
            For n = 0 To .ListCount - 1
                If Me.ListBox2.Selected(n) Then 'adds ListBox2 item to 
                                                'ListBox1
                    Me.ListBox1.AddItem .List(n)
                    Me.ListBox1.List(ListBox1.ListCount - 1, 0) = .List(n, 0)
                    Me.ListBox1.List(ListBox1.ListCount - 1, 1) = .List(n, 2)
                    Me.ListBox1.List(ListBox1.ListCount - 1, 2) = .List(n, 3)
                End If
            Next n
            For n = 0 To .ListCount - 1
                If .Selected(n) Then
                    .RemoveItem n 'removes the ListBox2 item
                    ws.Rows(n + 2).EntireRow.Delete 'removes the row from the 
                End if                            'ListBox2 source in Sheet 2
            Next n
        End With
    End With
    SheetTransfer
End Sub

Private Sub SheetTransfer() 'moves the ListBox items to respective sheet sources
    Set ws = Sheets(1)
    With ws
        For n = 0 To ListBox1.ListCount - 1
            .Cells(n + 2, 1).Value = Me.ListBox1.List(n, 0)
            .Cells(n + 2, 2).Value = Me.ListBox1.List(n, 1)
            .Cells(n + 2, 3).Value = Me.ListBox1.List(n, 2)
        Next n 
            FillListBox1
        For n = 0 To ListBox2.ListCount - 1
            wb.Sheets(2).Cells(n + 2, 3).Value = Me.ListBox2.List(n, 2)
            wb.Sheets(2).Cells(n + 2, 4).Value = Me.ListBox2.List(n, 3)
        Next i
    End With
    CheckLists
End Sub

Private Sub CheckLists() 'addtnl routine to check if listbox is truly 
'empty...otherwise header row will show up if listbox has no items
    Set ws = Sheets(2)
    Set rng = ws.Range("A2")
    With ws
        ListBox1.Clear
        ListBox2.Clear
        If WorksheetFunction.CountA(rng) <> 0 Then
            FillListBox2 'use List Property not RowSource
                If WorksheetFunction.CountA(Sheets(1).Range("A2")) <> 0 Then
                    FillListBox1 'use List Property not RowSource
                Else
                    Me.ListBox1.Clear
                End If
        Else
            Me.ListBox2.Clear
            FillListBox1 'in my application, ListBox1 fills from a lookuplist
        End If
    End With
End Sub