Как быстро перемещать элементы между двумя списками в Excel?
Вы когда-нибудь пытались переместить элементы из одного окна списка в другое, как вам нужно, как показано на скриншоте ниже? Здесь я расскажу об этой операции в Excel.
Перемещать элементы между списками
Перемещать элементы между списками
Нет встроенной функции, которая могла бы помочь вам завершить работу, но у меня есть код VBA, который может оказать вам услугу.
1. Во-первых, вам необходимо создать список данных, которые будут отображаться как элементы в списках на новом листе, который называется Админ_списки.
2. Затем выберите эти данные и перейдите в Фамилия коробка, чтобы дать им имя Список предметов. Смотрите скриншот:
3. Затем на листе, который будет содержать два списка, щелкните Застройщик > Вставить > Окно списка (Active X Control)и нарисуйте два списка. Смотрите скриншот:
Если же линия индикатора Застройщик вкладка скрыта ваша лента, Как отобразить вкладку разработчика в ленте Excel 2007/2010/2013? эта статья расскажет вам, как это показать.
4. Затем нажмите Застройщик > Вставить > Командная кнопка (активный элемент управления X)и нарисуйте четыре кнопки между двумя списками. Смотрите скриншот:
Теперь переименуем четыре командные кнопки с новыми именами.
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. Затем перейдите на другой лист, затем вернитесь к листу, содержащему списки, теперь вы можете видеть, что данные списка были перечислены в первом одном окне списка. И нажимайте кнопки команд, чтобы перемещать элементы между двумя списками.
Переместить выделение
Переместить все
Лучшие инструменты для офисной работы
Улучшите свои навыки работы с Excel с помощью Kutools for Excel и почувствуйте эффективность, как никогда раньше. Kutools for Excel предлагает более 300 расширенных функций для повышения производительности и экономии времени. Нажмите здесь, чтобы получить функцию, которая вам нужна больше всего...
Вкладка Office: интерфейс с вкладками в Office и упрощение работы
- Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
- Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
- Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!