Im Listobject Rang: MA=Mitarbeiter; C=Chef
Wenn du ein selektiertes Item im Listbox als erste plazieren möchtest, dann reicht diese Code:
Code:
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If ListBox1.ListIndex > -1 Then ListBox1.List = Split(ListBox1.Value & "_" & Join(Filter(Application.Transpose(ListBox1.List), ListBox1.Value, 0), "_"), "_")
Cancel = True
End Sub
Hallo Tim,
hier mal Deine Datei zurück mit Verschieben in der ListBox. Die ListBox darf aber nicht per RowSource verknüpft sein; das habe ich geändert.
Als "Variablen" habe ich mal 4 Labels eingefügt, um es besser zu visualieren. Da kann man auch richtige Variablen im Modul deklarieren.
Hier der Code fürs Verschieben mit der linken Maustaste:
Private Sub ListBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If ListBox1.ListIndex > -1 Then
Label1 = ListBox1.Value
Label2 = ListBox1.ListIndex
Else
Label1 = ""
Label2 = ""
Label3 = ""
Label4 = ""
End If
End Sub
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If ListBox1.ListIndex > -1 Then
Label3 = ListBox1.Value
Label4 = ListBox1.ListIndex
End If
End Sub
Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With ListBox1
If .ListIndex > -1 Then
If Label4 <> Label2 Then
'wenn getauscht werden soll
'.List(Label4) = Label1
'.List(Label2) = Label3
'wenn verschoben werden soll
.RemoveItem Label2
.AddItem Label1, Label4
.ListIndex = -1
.MousePointer = fmMousePointerNoDrop
Else
.MousePointer = fmMousePointerDefault
End If
End If
Label1 = ""
Label2 = ""
Label3 = ""
Label4 = ""
End With
End Sub
[
attachment=23639]
Gruß Uwe
Hi ihr,
das ist total abgefahren, dass der thread dann doch noch mal Fahrt aufnimmt.. .Wirklich klasse. Ich bin zur Zeit mit dem Handy online da ich unterwegs bin. Sobald ich zu Hause bin schaue ich mir die Lösungen auf jeden Fall an und danke herzlich.
Ich denke aber entsprechend eurer antworten, dass der thread so erstmal als erledigt angesehen werden kann. .
Wirklich Klasse danke
Hallo Tim,
mein erster Entwurf diente mehr zum Demonstrieren des Verschiebens in der ListBox, war aber noch fehlerhaft.
Nun habe ich das Ganze vervollständigt mit Ein- und Ausgabe und hoffe, dass es keine gravierenden Fehler beinhaltet.
Wichtig ist, vor dem Verschieben noch einmal auf den Eintrag zu klicken (lieber einmal mehr als zu wenig).
Gruß Uwe
' **************************************************************
' Modul: UserForm1 Typ = Userform
' **************************************************************
Option Explicit
Dim varTemp(1 To 4) As Variant
Private Sub ComboBox1_Change()
Dim lngL As Long
Dim objL As ListObject
Dim varL As Variant
Set objL = Worksheets("Daten").ListObjects("Tabelle1")
varL = objL.DataBodyRange.Value
ListBox1.Clear
For lngL = 1 To UBound(varL)
If varL(lngL, 1) = ComboBox1.Value Then
ListBox1.AddItem varL(lngL, 2)
End If
Next lngL
End Sub
Private Sub CommandButton1_Click()
'Speichern
Dim lngL As Long
Dim lngZ As Long
Dim objL As ListObject
Dim varL As Variant
Set objL = Worksheets("Daten").ListObjects("Tabelle1")
varL = objL.DataBodyRange.Value
For lngL = 1 To UBound(varL)
If varL(lngL, 1) = ComboBox1.Value Then
lngZ = lngZ + 1
varL(lngL, 2) = ListBox1.List(lngZ - 1)
varL(lngL, 3) = lngZ
End If
Next lngL
objL.DataBodyRange.Value = varL
End Sub
Private Sub CommandButton2_Click()
'Verwerfen
Unload Me
End Sub
Private Sub ListBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If ListBox1.ListIndex > -1 Then
varTemp(1) = ListBox1.Value
varTemp(2) = ListBox1.ListIndex
Else
Erase varTemp
End If
End Sub
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If ListBox1.ListIndex > -1 Then
varTemp(3) = ListBox1.Value
varTemp(4) = ListBox1.ListIndex
End If
End Sub
Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With ListBox1
If .ListIndex > -1 And varTemp(2) <> "" Then
If varTemp(4) <> varTemp(2) Then
'wenn getauscht werden soll
'.List(vartemp(4)) = vartemp(1)
'.List(vartemp(2)) = vartemp(3)
'wenn verschoben werden soll
.RemoveItem varTemp(2)
.AddItem varTemp(1), varTemp(4)
.ListIndex = -1
.MousePointer = fmMousePointerNoDrop
Else
.MousePointer = fmMousePointerDefault
End If
End If
Erase varTemp
End With
End Sub
Private Sub UserForm_Initialize()
With ComboBox1
.AddItem "BA1"
.AddItem "BA2"
.AddItem "BA3"
.AddItem "BA4"
End With
End Sub