|
hallo, ich habe nun folgendes Problem.
Ich habe einen Code bei dem ich die Daten verschiedener Spalten untschiedlich mischen kann.
Jedoch macht das Makro alles nur einmal und dann hängt es.
Ich möchte aber jedes mal, wenn ich das Makro aufrufe, dass sich die Daten mischen.
Hier mein Code:
Sub sortieren()
Dim lngCLC As Long
Dim lngListExist As Long
Dim lngOC As Long
Dim vListArr As Variant
vListArr = Array("Arndt", "Denise", "Andreas", "Sebastian", "Bruno", "Sarah", "Bianca", "Getrud", "Meike", "Jürgen", "Hannes", "Dennis", "Lia", "Evelin", "Rite", "Rebekka", "Melanie", "Hubert", "Fritz", "Hans")
lngListExist = Application.GetCustomListNum(vListArr)
If lngListExist > 0 Then
lngOC = lngListExist
Else
Application.AddCustomList listArray:=vListArr
lngCLC = Application.CustomListCount
lngOC = lngCLC
End If
'erste sortierung
Range("A3").Sort Key1:=Range("a22"), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'zweite Sortierung
Range("a3").Sort Key1:=Range("a22"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=lngOC, _
MatchCase:=False, Orientation:=xlTopToBottom
Range("b3").Sort Key1:=Range("b22"), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'zweite Sortierung
Range("b3").Sort Key1:=Range("b22"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=lngOC, _
MatchCase:=False, Orientation:=xlTopToBottom
Range("c3").Sort Key1:=Range("c22"), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'zweite Sortierung
Range("c3").Sort Key1:=Range("c22"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=lngOC, _
MatchCase:=False, Orientation:=xlTopToBottom
Range("d3").Sort Key1:=Range("d22"), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'zweite Sortierung
Range("d3").Sort Key1:=Range("d22"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=lngOC, _
MatchCase:=False, Orientation:=xlTopToBottom
Range("e3").Sort Key1:=Range("e22"), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'zweite Sortierung
Range("e3").Sort Key1:=Range("e22"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=lngOC, _
MatchCase:=False, Orientation:=xlTopToBottom
Range("f3").Sort Key1:=Range("f22"), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'zweite Sortierung
Range("f3").Sort Key1:=Range("f22"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=lngOC, _
MatchCase:=False, Orientation:=xlTopToBottom
Range("g3").Sort Key1:=Range("g22"), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'zweite Sortierung
Range("g3").Sort Key1:=Range("g22"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=lngOC, _
MatchCase:=False, Orientation:=xlTopToBottom
If lngListExist = 0 Then Application.DeleteCustomList ListNum:=lngCLC
End Sub
Ich bin über jede Hilfe Dankbar.
|