Как быстро переместить элементы между двумя списками в 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 for Applications. Смотрите скриншот.
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-дневная полнофункциональная пробная версия — без регистрации и кредитной карты
- Лучшее соотношение цены и качества — экономия по сравнению с покупкой отдельных надстроек