Hvordan flytter man hurtigt emner mellem to lister i Excel?
Har du nogensinde prøvet at flytte elementerne fra en liste til en anden listebokse, som du har brug for som vist nedenstående skærmbillede? Her vil jeg tale om denne operation i Excel.
 |
 |
 |
Flyt emner mellem lister
Der er ingen indbygget funktion, der kan hjælpe dig med at afslutte jobbet, men jeg har en VBA-kode, der kan gøre en tjeneste.
1. For det første skal du oprette en liste med data, der vises som emnerne i listebokse i et nyt ark, der kaldes Admin_Lister.
2. Vælg derefter disse data, og gå til Navn for at give dem et navn Vareliste. Se skærmbillede:
3. Klik derefter på et ark, der indeholder de to lister Udvikler > indsatte > Listeboks (Aktiv X-kontrol), og tegn to lister. Se skærmbillede:
 |
|
 |
Hvis Udvikler fanen er skjult dit bånd, Hvordan vises / viser fanen udvikler i Excel 2007/2010/2013 Ribbon? denne artikel fortæller dig, hvordan du viser det.
4. Klik derefter på Udvikler > indsatte > Kommando-knap (Aktiv X-kontrol), og tegn fire knapper mellem to listefelter. Se skærmbillede:
 |
|
 |
Nu for at omdøbe de fire kommandoknapper med nye navne.
5. Vælg den første kommandoknap, klik på Ejendomme, og i Ejendomme rude, giv et navn BTN_moveAllRight til det, og skriv >> ind i tekstboksen ved siden af Caption. Se skærmbillede:
6. Gentag trin 5 for at omdøbe de sidste tre kommandoknapper med nedenstående navne, og skriv også den forskellige pil i billedteksterne. Se skærmbillede:
BTN_MoveSelectedRight
BTN_moveAllLeft
BTN_MoveSelectedLeft
 |
 |
 |
7. Højreklik på det arknavn, der indeholder lister og kommandoknapper, og vælg Vis kode fra genvejsmenuen. Se skærmbillede:
8. Kopier og indsæt nedenunder makrokoden til Moduler gem derefter koden og luk Microsoft Visual Basic til applikationer vindue. Se skærmbillede
VBA: Flyt emner mellem to listefelter
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. Gå derefter til et andet ark, og gå derefter tilbage til arket, der indeholder lister, nu kan du se, at listerne er blevet vist i den første liste. Og klik på kommandoknapperne for at flytte elementerne mellem to listefelter.
Flyt markeringen
 |
|
 |
Flyt alle
 |
|
 |
Bedste kontorproduktivitetsværktøjer
Overlad dine Excel-færdigheder med Kutools til Excel, og oplev effektivitet som aldrig før. Kutools til Excel tilbyder over 300 avancerede funktioner for at øge produktiviteten og spare tid. Klik her for at få den funktion, du har mest brug for...
Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere
- Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
- Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
- Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!
