Jak rychle přesouvat položky mezi dvěma seznamy v aplikaci Excel?
Zkoušeli jste někdy přesouvat položky z jednoho seznamu do jiného seznamu, jak potřebujete, jak je ukázáno níže? Zde budu hovořit o této operaci v aplikaci Excel.
 |
 |
 |
Přesouvat položky mezi seznamy
Přesouvat položky mezi seznamy
Neexistuje žádná vestavěná funkce, která vám pomůže dokončit práci, ale mám kód VBA, který vám může poskytnout laskavost.
1. Nejprve musíte vytvořit seznam dat, která se zobrazí jako položky v seznamech na novém listu, který volá Seznamy_správců.
2. Poté vyberte tato data a přejděte na Příjmení pole pro jejich pojmenování Seznam položek. Viz snímek obrazovky:
3. Potom v listu, který bude obsahovat dvě seznamová pole, klikněte na Vývojka > Vložit > Seznam (ovládací prvek Active X)a nakreslete dvě seznamová pole. Viz screenshot:
 |
|
 |
V případě, že Vývojka karta skrývá vaši stuhu, Jak zobrazit / zobrazit kartu vývojáře na pásu karet aplikace Excel 2007/2010/2013? tento článek vám řekne, jak to ukázat.
4. Pak klikněte na tlačítko Vývojka > Vložit > Příkazové tlačítko (ovládání Active X)a nakreslete čtyři tlačítka mezi dvěma seznamy. Viz screenshot:
 |
|
 |
Nyní přejmenujte čtyři příkazová tlačítka s novými názvy.
5. Vyberte první příkazové tlačítko, klepněte na Nemovitosti, a v Nemovitosti v podokně uveďte název BTN_moveAllRight k tomu a zadejte >> do textového pole vedle Titulek. Viz snímek obrazovky:
6. Opakováním kroku 5 přejmenujte poslední tři příkazové tlačítko s níže uvedenými názvy a také zadejte jinou šipku do titulků. Viz screenshot:
BTN_MoveSelectedRight
BTN_moveAllLeft
BTN_MoveSelectedLeft
 |
 |
 |
7. Klikněte pravým tlačítkem na název listu, který obsahuje seznamová pole a příkazová tlačítka, a vyberte Zobrazit kód z kontextové nabídky. Viz snímek obrazovky:
8. Zkopírujte a vložte pod kód makra do Modul skript poté uložte kód a zavřete Microsoft Visual Basic pro aplikace okno. Viz snímek obrazovky
VBA: Přesunutí položek mezi dvěma seznamy
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. Poté přejděte na jiný list a poté se vraťte na list, který obsahuje seznamová pole, nyní můžete vidět, že seznam byl v seznamu v prvním seznamu. Kliknutím na příkazová tlačítka můžete přesouvat položky mezi dvěma seznamy.
Přesunout výběr
 |
|
 |
Přesunout vše
 |
|
 |
Nejlepší nástroje pro produktivitu v kanceláři
Rozšiřte své dovednosti Excel pomocí Kutools pro Excel a zažijte efektivitu jako nikdy předtím. Kutools for Excel nabízí více než 300 pokročilých funkcí pro zvýšení produktivity a úsporu času. Kliknutím sem získáte funkci, kterou nejvíce potřebujete...
Office Tab přináší do Office rozhraní s kartami a usnadňuje vám práci
- Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
- Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
- Zvyšuje vaši produktivitu o 50%a snižuje stovky kliknutí myší každý den!
