Thema: Daten in Matrix indizieren

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

Beiträge aus dem Excel-Forum zu den Themen Matrix und Kriterien