Gruppe
Dialog
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.
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