Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Daten in ListBoxes verschieben und sortieren

Gruppe

ListBox

Problem

Die Werte aus Spalte A sollen in eine UserForm-ListBox eingelesen werden. In der UserForm sollen die Werte von einer ListBox zur anderen verschoben und jeweils nach dem Sortierkriterium der Anordnung in der Tabelle sortiert werden können.

Lösung
Geben Sie den Ereigniscode in die nachfolgend genannten Module ein.

ClassModule: frmListen

Private Sub cmdHer_Click()
   Dim arr As Variant
   Dim iRow As Integer, iCount As Integer
   If lstB.ListIndex = -1 Then
      Beep
      MsgBox "Sie müssen ein Element auswählen!"
      Exit Sub
   End If
   arr = ActiveSheet.Range("A1").CurrentRegion
   lstA.AddItem lstB.Value
   lstB.RemoveItem lstB.ListIndex
   Workbooks.Add
   Range(Cells(1, 1), Cells(lstA.ListCount, 1)).Value = lstA.List
   iCount = Application.CustomListCount
   Application.AddCustomList arr
   Range("A1").CurrentRegion.Sort key1:=Range("A1"), order1:=xlAscending, _
      ordercustom:=iCount + 2, header:=xlNo
   If IsEmpty(Range("A2")) Then
      lstA.Clear
      lstA.AddItem Range("A1").Value
   Else
      lstA.List = Range("A1").CurrentRegion.Value
   End If
   Application.DeleteCustomList iCount + 1
   ActiveWorkbook.Close savechanges:=False
End Sub

Private Sub cmdHin_Click()
   Dim arr As Variant
   Dim iRow As Integer, iCount As Integer
   If lstA.ListIndex = -1 Then
      Beep
      MsgBox "Sie müssen ein Element auswählen!"
      Exit Sub
   End If
   arr = ActiveSheet.Range("A1").CurrentRegion
   lstB.AddItem lstA.Value
   lstA.RemoveItem lstA.ListIndex
   Workbooks.Add
   Range(Cells(1, 1), Cells(lstB.ListCount, 1)).Value = lstB.List
   iCount = Application.CustomListCount
   Application.AddCustomList arr
   Range("A1").CurrentRegion.Sort _
      key1:=Range("A1"), order1:=xlAscending, _
      ordercustom:=iCount + 2, header:=xlNo
   If IsEmpty(Range("A2")) Then
      lstB.Clear
      lstB.AddItem Range("A1").Value
   Else
      lstB.List = Range("A1").CurrentRegion.Value
   End If
   Application.DeleteCustomList iCount + 1
   ActiveWorkbook.Close savechanges:=False
End Sub

Private Sub cmdWeiter_Click()
   Unload Me
End Sub

Private Sub UserForm_Initialize()
   lstA.List = Range("A1").CurrentRegion.Value
End Sub

StandardModule: basMain

Sub CallForm()
   frmListen.Show
End Sub