Hur flyttar jag snabbt objekt mellan två listrutor i Excel?

Har du någonsin försökt flytta objekten från en listruta till en annan listrutor som du behöver enligt nedanstående skärmdump? Här kommer jag att prata om denna operation i Excel.

Flytta objekt mellan listrutor

Flytta objekt mellan listrutor

Det finns ingen inbyggd funktion som kan hjälpa dig att slutföra jobbet, men jag har en VBA-kod kan göra en tjänst.

1. För det första måste du skapa en lista med data som visas som objekten i listrutorna i ett nytt ark som ringde Admin_Lists.

2. Välj sedan dessa data och gå till Namn rutan för att ge dem ett namn Varulista. Se skärmdump:

3. Klicka sedan på ett ark som innehåller de två listrutorna Utvecklare > Insert > Listbox (Active X Control)och rita två listrutor. Se skärmdump:

Om Utvecklare fliken är dold ditt band, Hur visar / visa fliken utvecklare i Excel 2007/2010/2013 Ribbon? den här artikeln kommer att berätta hur du visar den.

4. Klicka sedan Utvecklare > Insert > Kommando-knapp (Active X-kontroll), och rita fyra knappar mellan två listrutor. Se skärmdump:

Nu för att byta namn på de fyra kommandoknapparna med nya namn.

5. Välj första kommandoknappen, klicka Våra Bostäder, och i Våra Bostäder fönstret, ge ett namn BTN_moveAllRight till det och skriv >> i textrutan bredvid Bildtext. Se skärmdump:

6. Upprepa steg 5 för att byta namn på de tre sista kommandoknappen med nedanstående namn och skriv också in olika pil i bildtexterna. Se skärmdump:

BTN_MoveSelectedRight

BTN_moveAllLeft

BTN_MoveSelectedLeft

7. Högerklicka på arknamnet som innehåller listrutorna och kommandoknapparna och välj Visa kod från snabbmenyn. Se skärmdump:

8. Kopiera och klistra in nedanför makrokoden till Modulerna spara sedan koden och stäng Microsoft Visual Basic för applikationer fönster. Se skärmdump

VBA: Flytta objekt mellan två listrutor

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å sedan till ett annat ark och gå sedan tillbaka till arket innehåller listrutorna, nu kan du se listdata har listats i den första listrutan. Och klicka på kommandoknapparna för att flytta objekten mellan två listrutor.

Flytta markeringen

Flytta alla