Excel'de iki liste kutusu arasında öğeleri hızlıca nasıl taşırsınız?

Aşağıdaki ekran görüntüsünde gösterildiği gibi, bir liste kutusundaki öğeleri başka bir liste kutusuna taşımaya çalıştınız mı? Burada bu işlemi Excel'de nasıl yapabileceğinizden bahsedeceğim.

Liste kutuları arasında öğeleri taşıma

Liste kutuları arasında öğeleri taşıma

Bu işi tamamlamanıza yardımcı olacak yerleşik bir fonksiyon yok, ancak size yardımcı olabilecek bir VBA kodum var.

1. İlk olarak, Admin_Lists adlı yeni bir çalışma sayfasında liste kutularında gösterilecek veri listesi oluşturmanız gerekir.

2. Ardından bu verileri seçin ve Ad kutusuna tıklayarak ItemList adını verin. Ekran görüntüsüne bakın:

3. Sonra iki liste kutusunu içerecek çalışma sayfasında Geliştirici > Ekle > Liste Kutusu (Active X Kontrolü)’ne tıklayın ve iki liste kutusu çizin. Ekran görüntüsüne bakın:

Geliştirici sekmesi şeritte gizliyse, Excel 2007/2010/2013 Şeridinde Geliştirici sekmesini nasıl gösterirsiniz/görüntülersiniz? Bu makale size bunu nasıl yapacağınızı anlatacak.

4. Ardından Geliştirici > Ekle > Komut Düğmesi (Active X Kontrolü)’ne tıklayın ve iki liste kutusu arasına dört düğme çizin. Ekran görüntüsüne bakın:

Şimdi dört komut düğmesini yeni adlarla yeniden adlandırın.

5. İlk komut düğmesini seçin, Özellikler’e tıklayın ve Özellikler panelinde ona BTN_moveAllRight adını verin ve Başlık yanındaki metin kutusuna >> yazın. Ekran görüntüsüne bakın:

6. Adım 5’i tekrar ederek son üç komut düğmesini aşağıdaki adlarla yeniden adlandırın ve ayrıca başlıklara farklı okları yazın. Ekran görüntüsüne bakın:

BTN_MoveSelectedRight

BTN_moveAllLeft

BTN_MoveSelectedLeft

7. Liste kutuları ve komut düğmelerini içeren çalışma sayfasının adına sağ tıklayın ve bağlam menüsünden Kodu Görüntüle’yi seçin. Ekran görüntüsüne bakın:

8. Aşağıdaki makro kodunu Modül betiğine kopyalayıp yapıştırın, ardından kodu kaydedin ve Microsoft Visual Basic for Applications penceresini kapatın. Ekran görüntüsüne bakın:

VBA: İki liste kutusu arasında öğeleri taşıma

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. Ardından başka bir çalışma sayfasına gidin ve liste kutularını içeren çalışma sayfasına geri dönün, şimdi liste verilerinin ilk liste kutusunda listelendiğini görebilirsiniz. Ve komut düğmelerine tıklayarak öğeleri iki liste kutusu arasında taşıyabilirsiniz.

Seçimi taşı

Tümünü taşı