Question

请帮我查看列表框。我想做的是：
我从列表框中选择了两个项目并将它们移到右侧。

我保存了Excel文件。我重新打开了文件，右边没有任何内容。

请帮忙。我在VBA中使用了以下代码：

Private Sub CommandButton6_Click()
    Dim iCtr As Long

    For iCtr = 0 To Me.ListBox2.ListCount - 1
        Me.ListBox1.AddItem Me.ListBox2.List(iCtr)
    Next iCtr
    Me.ListBox2.Clear
End Sub

Private Sub BTN_moveAllRight_Click()  
    Dim iCtr As Long

    For iCtr = 0 To Me.ListBox1.ListCount - 1
        Me.ListBox2.AddItem Me.ListBox1.List(iCtr)
    Next iCtr
    Me.ListBox1.Clear
End Sub

Private Sub BTN_MoveSelectedLeft_Click()
    Dim iCtr As Long

    For iCtr = 0 To Me.ListBox2.ListCount - 1
        If Me.ListBox2.Selected(iCtr) = True Then
            Me.ListBox1.AddItem Me.ListBox2.List(iCtr)
        End If
    Next iCtr

    For iCtr = Me.ListBox2.ListCount - 1 To 0 Step -1
        If Me.ListBox2.Selected(iCtr) = True Then
            Me.ListBox2.RemoveItem iCtr
        End If
    Next iCtr
End Sub

Private Sub BTN_MoveSelectedRight_Click()
    Dim iCtr As Long

    For iCtr = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(iCtr) = True 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 Then
            Me.ListBox1.RemoveItem iCtr
        End If
    Next iCtr
End Sub

Private Sub cmdOK_Click()
     Unload Me
End Sub

Private Sub Worksheet_Activate()
    Dim myCell As Range
    Dim rngItems As Range
    Set rngItems = Sheets("Subject Disposition").Range("Route")

    Me.ListBox1.Clear
    Me.ListBox2.Clear

    With Me.ListBox1
        .LinkedCell = ""
        .ListFillRange = ""
        For Each myCell In rngItems.Cells
            If Trim(myCell) <> "" Then
                .AddItem myCell.Value
            End If
        Next myCell
    End With

    Me.ListBox1.MultiSelect = fmMultiSelectMulti
    Me.ListBox2.MultiSelect = fmMultiSelectMulti
End Sub

Answer 1

我为你做了一个样品首先设置源表（在此示例中，我们使用Sheet1）和UserForm，如下所示：

enter image description here

如您所见，我们在单元格A1中有初始数据或列表：Sheet1中的A10 要在您创建的 UserForm 中显示它，可以使用 UserForm_Initialize 事件中的 RowSource 属性，就像David指出的那样。（见下文）
然后你会看到其余按钮的代码，这些代码可以移动从左到右选择的项目，反之亦然。也可以全部向左或向右移动按钮基本上，我们正在做的是在 Sheet1 中操作范围对象，然后在每个代码块的末尾更新 RowSource 属性以使其成为可能看起来我们正在操纵列表框现在，当您保存工作表时，它将保留范围A1：A10和B1：B10具有的任何值。 HTH

Option Explicit

Private Sub CommandButton1_Click() 'move item right to left
    Dim rng As Range
    Dim i As Long, j As Long

    With Me.ListBox2 'right listbox
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
                Set rng = Sheet1.Range("B1:B10").Find(.List(i), [B10])
                If Not rng Is Nothing Then
                    With Sheet1
                        If Len(.Range("A1").Value) = 0 Then
                            j = 1
                        Else
                            j = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Row
                        End If
                        rng.Copy .Range("A" & j)
                        rng.Delete xlUp
                    End With
                End If
            End If
        Next
    End With

    DoEvents
    Me.ListBox1.RowSource = _
        "'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "A1:A10"
    Me.ListBox2.RowSource = _
        "'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "B1:B10"
End Sub

Private Sub CommandButton2_Click() 'move item left to right
    Dim rng As Range
    Dim i As Long, j As Long

    With Me.ListBox1 'left listbox
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
                Set rng = Sheet1.Range("A1:A10").Find(.List(i), [A10])
                If Not rng Is Nothing Then
                    With Sheet1
                        If Len(.Range("B1").Value) = 0 Then
                            j = 1
                        Else
                            j = .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0).Row
                        End If
                        rng.Copy .Range("B" & j)
                        rng.Delete xlUp
                    End With
                End If
            End If
        Next
    End With

    DoEvents
    Me.ListBox1.RowSource = _
        "'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "A1:A10"
    Me.ListBox2.RowSource = _
        "'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "B1:B10"
End Sub

Private Sub CommandButton3_Click() 'move all to left
    Dim rng As Range

    With Sheet1
        If Me.ListBox2.ListCount = 0 Then Exit Sub
        Set rng = .Range("B1", .Range("B" & .Rows.Count).End(xlUp))
        If Len(.Range("A1").Value) = 0 Then
            rng.Copy .Range("A1")
        Else
            rng.Copy .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
        End If
        rng.ClearContents
    End With

    DoEvents
    Me.ListBox1.RowSource = _
        "'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "A1:A10"
    Me.ListBox2.RowSource = _
        "'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "B1:B10"
End Sub

Private Sub CommandButton4_Click() 'move all to right
    Dim rng As Range

    With Sheet1
        If Me.ListBox1.ListCount = 0 Then Exit Sub
        Set rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
        If Len(.Range("B1").Value) = 0 Then
            rng.Copy .Range("B1")
        Else
            rng.Copy .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0)
        End If
        rng.ClearContents
    End With

    DoEvents
    Me.ListBox1.RowSource = _
        "'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "A1:A10"
    Me.ListBox2.RowSource = _
        "'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "B1:B10"
End Sub

Private Sub UserForm_Initialize()
    'Initialize the left and right listbox value
    Me.ListBox1.RowSource = _
        "'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "A1:A10"
    Me.ListBox2.RowSource = _
        "'[" & ThisWorkbook.Name & "]" & Sheet1.Name & "'!" & "B1:B10"
End Sub

使用列表框从左向右移动值后保存

1 个答案: