AW: Sortieren, mit Bereichsnamen gesteuert
01.05.2007 14:38:14
fcs
Hallo Peter,
hab den Code nochmals etwas angepasst, so dass auch die mit den Namen Prio1 bis Prio3 benamten Zellen im Makro verarbeitet werden.
Das Sortiermakro erwartet für die zu sortierende Spalte eine Zahlenangabe in welcher Reihenfolge die Spalten des Sortierbereichs sortiert werden. 1 entspricht dabei der linken Spalte des zu sortierenden Bereichs.
Beispiel: Der zu sortierende Bereich ist C1:K200. Du möchtest nach den Spalten H, C und D sortieren.
Dann sind die Prioritäten Prio1 = 6, Prio2 =1 und Prio3 = 2
Gruß
Franz
Sub AAASortieren()
Dim Priotaet() As Integer, Bereichsname As Name, wks As Worksheet
Dim SortierBereich As Range
'Berechnen auf manuell setzen und Ereignismakros deaktivieren
With Application
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'GoTo Test 'Testzeile für Sprung zu Variante für mehrere Tabellen
'Beispiel wenn die Bereichsnamen nur einmal einer Tabelle der Datei vorkommen bzw. bei _
gleichen Namen in mehren Tabellen immer nur in der aktiven Tabelle sortiert werden soll
With Application
ReDim Prioritaet(1 To 3)
Set SortierBereich = .Range("SortDaten")
'Prüfung welche Bereichsnamen angelegt sind
For Each Bereichsname In ActiveWorkbook.Names
Select Case Bereichsname.Name
Case "Prio1"
Prioritaet(1) = .Range("Prio1").Column - SortierBereich.Column + 1
Case "Prio2"
Prioritaet(2) = .Range("Prio2").Column - SortierBereich.Column + 1
Case "Prio3"
Prioritaet(3) = .Range("Prio3").Column - SortierBereich.Column + 1
Case Else
'do nothing
End Select
Next
Call BereichSortieren(Bereich:=SortierBereich, _
Prio1:=Prioritaet(1), Prio2:=Prioritaet(2), Prio3:=Prioritaet(3))
End With
MsgBox "weiter"
GoTo Weiter 'Zeile zum Testen
Test: 'sprungadresse zum Testen
'oder wenn in mehreren Tabellen der Datei mit den gleichen Bereichsnamen _
gearbeitet wird, z.B. Tabelle1!SortDaten, Tabelle1!Prio1, Tabelle1!Prio2, _
Tabelle1!Prio3 und entsprechend für die anderen Tabellen. _
Diese Variante wird nur dann erforderlich, wenn man nicht in der aktiven _
Tabelle sortieren möchte
Set wks = Worksheets("Tabelle1")
With wks
ReDim Prioritaet(1 To 3)
Set SortierBereich = .Range(wks.Name & "!SortDaten")
'Prüfung welche Bereichsnamen angelegt sind
For Each Bereichsname In wks.Names
Select Case Bereichsname.Name
Case wks.Name & "!Prio1"
Prioritaet(1) = .Range("Prio1").Column - SortierBereich.Column + 1
Case wks.Name & "!Prio2"
Prioritaet(2) = .Range("Prio2").Column - SortierBereich.Column + 1
Case wks.Name & "!Prio3"
Prioritaet(3) = .Range("Prio3").Column - SortierBereich.Column + 1
Case Else
'do nothing
End Select
Next
Call BereichSortieren(Bereich:=SortierBereich, _
Prio1:=Prioritaet(1), Prio2:=Prioritaet(2), Prio3:=Prioritaet(3))
End With
Weiter:
'Berechnen wieder auf automatisch setzen und Ereignismakros wieder aktivieren
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub
Sub BereichSortieren(Bereich As Range, ByVal Prio1%, Optional ByVal Prio2%, _
Optional ByVal Prio3%)
'Prio1 bis Prio3 gibt die Reihenfolge der Spalten in Bereich an nach der sortiert _
werden soll
On Error GoTo Fehler
If Prio1 > 0 And Prio2 > 0 And Prio3 > 0 Then
Bereich.Sort Key1:=Bereich.Range("A1").Offset(0, Prio1 - 1), Order1:=xlAscending, _
Key2:=Bereich.Range("A1").Offset(0, Prio2 - 1), Order2:=xlAscending, _
Key3:=Bereich.Range("A1").Offset(0, Prio3 - 1), Order3:=xlAscending, _
Header:=xlNo
ElseIf Prio1 > 0 And Prio2 > 0 Then
Bereich.Sort Key1:=Bereich.Range("A1").Offset(0, Prio1 - 1), Order1:=xlAscending, _
Key2:=Bereich.Range("A1").Offset(0, Prio2 - 1), Order2:=xlAscending, _
Header:=xlNo
ElseIf Prio1 > 0 Then
Bereich.Sort Key1:=Bereich.Range("A1").Offset(0, Prio1 - 1), Order1:=xlAscending, _
Header:=xlNo
End If
Exit Sub
Fehler:
MsgBox "Fehler " & Err.Number & "ist aufgetreten!" & vbLf & _
"Meldung: " & Err.Description
End Sub