Как быстро перемещать элементы между двумя списками в Excel?
Приходилось ли вам когда-нибудь перемещать элементы из одного списка в другой, как на скриншоте ниже? Далее я покажу, как выполнить эту операцию в Excel.
 |  |  |
Перемещение элементов между списками
Перемещение элементов между списками
Встроенной функции для выполнения этой задачи нет, но у меня есть код VBA, который может помочь.
1. Сначала создайте список данных, который будет отображаться в виде элементов в списках на новом листе с названием Admin_Lists.
2. Затем выделите эти данные и перейдите в поле Имя, чтобы присвоить им имя ItemList. См. скриншот:
3. Затем на листе, где будут находиться два списка, нажмите Разработчик > Вставить > Поле со списком (элемент управления ActiveX) и нарисуйте два поля со списком. См. скриншот:
 | |  |
Если вкладка Разработчик скрыта на вашей Ленте, Как отобразить вкладку «Разработчик» в Excel 2007/2010/2013 Лента? — эта статья расскажет, как её показать.
4. Затем нажмите Разработчик > Вставить > Кнопка (элемент управления ActiveX) и нарисуйте четыре кнопки между двумя списками. См. скриншот:
 | |  |
Теперь переименуйте четыре кнопки команд, воспользовавшись функцией «Новое имя».
5. Выделите первую кнопку команды, нажмите Свойства и в области Свойства задайте ей имя BTN_moveAllRight, а также введите >> в текстовое поле рядом с параметром Надпись. См. скриншот:
6. Повторите шаг 5, чтобы переименовать последние три кнопки команды, как указано ниже, и добавьте соответствующие стрелки в их надписи. См. скриншот:
BTN_MoveSelectedRight
BTN_moveAllLeft
BTN_MoveSelectedLeft
 |  |  |
7. Щёлкните правой кнопкой мыши по имени листа, содержащего списки и кнопки команд, и выберите в контекстном меню пункт Просмотреть код. См. скриншот:
8. Скопируйте и вставьте приведённый ниже макрокод в окно Модуль, затем сохраните код и закройте окно Microsoft Visual Basic для приложений. См. скриншот
VBA: Перемещение элементов между двумя списками
Private Sub Worksheet_Activate()
'UpdatebyExtendoffice20171117
Dim xCell As Range
Dim xRg As Range
Set xRg = Sheets("Admin_Lists").Range("ItemList")
Me.ListBox1.Clear
Me.ListBox2.Clear
With Me.ListBox1
.LinkedCell = ""
.ListFillRange = ""
For Each xCell In xRg
If xCell <> "" Then
.AddItem xCell.Value
End If
Next xCell
End With
Me.ListBox1.MultiSelect = fmMultiSelectMulti
Me.ListBox2.MultiSelect = fmMultiSelectMulti
End Sub
Private Sub BTN_MoveSelectedLeft_Click()
Call moveSigle(Me.ListBox2, Me.ListBox1)
End Sub
Private Sub BTN_MoveSelectedRight_Click()
Call moveSigle(Me.ListBox1, Me.ListBox2)
End Sub
Private Sub BTN_moveAllLeft_Click()
Call moveAll(Me.ListBox2, Me.ListBox1)
End Sub
Private Sub BTN_moveAllRight_Click()
Call moveAll(Me.ListBox1, Me.ListBox2)
End Sub
Sub moveAll(xListBox1 As Object, xListBox2 As Object)
Dim I As Long
For I = 0 To xListBox1.ListCount - 1
xListBox2.AddItem xListBox1.List(I)
Next I
xListBox1.Clear
End Sub
Sub moveSigle(xListBox1 As Object, xListBox2 As Object)
Dim I As Long
For I = 0 To xListBox1.ListCount - 1
If I = xListBox1.ListCount Then Exit Sub
If xListBox1.Selected(I) = True Then
xListBox2.AddItem xListBox1.List(I)
xListBox1.RemoveItem I
I = I - 1
End If
Next
End Sub
9. Перейдите на другой лист и вернитесь обратно на лист со списками — теперь данные будут отображаться в первом списке. Нажимайте кнопки команд, чтобы перемещать элементы между двумя списками.
Переместить выделенное
 | |  |
Переместить всё
 | |  |
Лучшие инструменты повышения продуктивности в Office
Раскройте весь потенциал Excel с помощью Kutools для Excel и ощутите эффективность как никогда раньше.Kutools для Excel предлагает более 300 расширенных функций для повышения продуктивности и Экономия времени.Нажмите здесь, чтобы получить нужную Вам функцию…
Office Tab добавляет в Office вкладки и значительно упрощает Вашу работу
- Включите редактирование и чтение во вкладках в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Открывайте и создавайте несколько документов во вкладках одного окна — вместо того чтобы использовать отдельные окна.
- Повышает вашу продуктивность на 50 % и экономит сотни кликов мышью каждый день!
Все надстройки Kutools — один установщик
Kutools for Office — набор надстроек для Excel, Word, Outlook и PowerPoint, а также Office Tab Pro, идеально подходящий командам, работающим с разными приложениями Office.
- Единый комплект— надстройки для Excel, Word, Outlook и PowerPoint + Office Tab Pro
- Один установщик, одна лицензия— настройка занимает считанные минуты (готово для MSI)
- Лучше работать вместе— оптимизированная продуктивность во всех приложениях Office
- 30-дневная полнофункциональная пробная версия— без регистрации и кредитной карты
- Лучшее соотношение цены и качества— экономия по сравнению с покупкой отдельных надстроек