Блог

Главная - Вопросы по программированию - Сохранение после перемещения значений слева направо с помощью списков

Сохранение после перемещения значений слева направо с помощью списков

#vba #excel

#vba #excel

Вопрос:

Пожалуйста, помогите мне со списками. Что я пытаюсь сделать, так это:
я выбрал два элемента из списка и переместил их вправо.

Я сохранил файл 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

Комментарии:

1. Неясно, о чем вы спрашиваете. Пожалуйста, подумайте о пересмотре вашего вопроса, чтобы включить более подробную информацию, включая скриншоты (если у вас недостаточно репутации, чтобы загрузить их здесь, отправьте их на imgur.com и добавьте ссылки). Включите более подробное описание, а не просто сбрасывайте свой код. Текущий код, похоже, не имеет ничего похожего на «перемещение влево или вправо», поэтому неясно, что вы ожидаете, должно произойти…

2. Также обратите внимание, что изменения в элементах управления формы обычно не сохраняются после _Terminate события формы. Если вам нужно изменить значение по умолчанию, вам нужно будет что-то сделать в Initialize или Activate обработчике событий формы…

3. @DavidZemens Большое спасибо за ваши комментарии. Что я пытаюсь сделать, так это то, что я переместил два значения из левого поля вправо, как показано на скриншоте_1 ( i.imgur.com/YwhuXyw.jpg ). После сохранения файла Excel, если я снова открою файл Excel, он снова вернется к настройкам по умолчанию, как показано на скриншоте_2 ( imgur.com/9vCJfEb ). Изменения не были сохранены.

4. То, что вы хотите, не может быть сделано с помощью используемого вами кода. Как сказал Дэвид, изменения не будут сохраняться после завершения кода. Что вы можете сделать, это передать выбранные вами элементы куда-нибудь на листе, а затем использовать свойство RowSource для извлечения его позже. Или, что еще лучше, обновите свой код, чтобы полностью использовать это свойство.

5. @L42 Большое спасибо за ваши комментарии и помощь. Не могли бы вы указать мне, что и куда добавить свойство. Я не эксперт в VBA. Читая разные блоги и справку, я написал код, упомянутый выше. Заранее большое спасибо за вашу помощь.

Ответ №1:

Я сделал образец для вас.
Сначала настройте исходный лист (в этом примере мы используем Лист1) и пользовательскую форму, как показано ниже:

введите описание изображения здесь

Как вы можете видеть, у нас есть исходные данные или список в ячейке A1: A10 на листе 1.
Чтобы отобразить его в созданной вами пользовательской форме, вы используете свойство RowSource, как показано в событии UserForm_Initialize, как указал Дэвид. (Смотрите ниже)
И затем вы видите коды для остальных кнопок, которые перемещают выбранные элементы слева направо и наоборот. Также кнопка переместить все влево или вправо.
По сути, мы манипулируем объектами диапазона в листе 1, а затем обновляем свойство 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" amp; .Rows.Count).End(xlUp).Offset(1, 0).Row
                        End If
                        rng.Copy .Range("A" amp; j)
                        rng.Delete xlUp
                    End With
                End If
            End If
        Next
    End With

    DoEvents
    Me.ListBox1.RowSource = _
        "'[" amp; ThisWorkbook.Name amp; "]" amp; Sheet1.Name amp; "'!" amp; "A1:A10"
    Me.ListBox2.RowSource = _
        "'[" amp; ThisWorkbook.Name amp; "]" amp; Sheet1.Name amp; "'!" amp; "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" amp; .Rows.Count).End(xlUp).Offset(1, 0).Row
                        End If
                        rng.Copy .Range("B" amp; j)
                        rng.Delete xlUp
                    End With
                End If
            End If
        Next
    End With

    DoEvents
    Me.ListBox1.RowSource = _
        "'[" amp; ThisWorkbook.Name amp; "]" amp; Sheet1.Name amp; "'!" amp; "A1:A10"
    Me.ListBox2.RowSource = _
        "'[" amp; ThisWorkbook.Name amp; "]" amp; Sheet1.Name amp; "'!" amp; "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" amp; .Rows.Count).End(xlUp))
        If Len(.Range("A1").Value) = 0 Then
            rng.Copy .Range("A1")
        Else
            rng.Copy .Range("A" amp; .Rows.Count).End(xlUp).Offset(1, 0)
        End If
        rng.ClearContents
    End With

    DoEvents
    Me.ListBox1.RowSource = _
        "'[" amp; ThisWorkbook.Name amp; "]" amp; Sheet1.Name amp; "'!" amp; "A1:A10"
    Me.ListBox2.RowSource = _
        "'[" amp; ThisWorkbook.Name amp; "]" amp; Sheet1.Name amp; "'!" amp; "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" amp; .Rows.Count).End(xlUp))
        If Len(.Range("B1").Value) = 0 Then
            rng.Copy .Range("B1")
        Else
            rng.Copy .Range("B" amp; .Rows.Count).End(xlUp).Offset(1, 0)
        End If
        rng.ClearContents
    End With

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