Tabelle priorisieren
Stefan
Hallo zusammen ich brauche einen Anstoß...
ich habe eine Tabelle die ich sortieren möchte. Bis dato habe ich alles absteigend nach Zahlen sortiert, jetzt will ich aber nach "Worten" und dann nach Zahlen sortieren.
Zunächst sollte absteigend von HOCH - MITTEL - NIEDRIG nach unten sortiert werden
Und anschließend dann absteigend nach Zahlen.
Aussehen sollte dass dann beispielsweise so:
Hoch 25
Hoch 24
Hoch 24
Mittel 25
Mittel 24
Mittel 24
Niedrig 12
Niedrig 11
Den bisherigen Code den ich verwende habe ich angehängt, kann mir da einer einen Gedankanstoß geben oder soll ich einfach über eine zusatzspalte wieder über zahlen sortieren?
Mit VBA stehe ich meist auf Kriegsfuß, wenn man das in Hinblick auf die angespannte Weltlage überhaupt noch sagen darf...
Vielen Dank für eine mögliche Hilfe.
VG
Stefan
Sub Priorisieren()
'
' Tabelle_priorisieren Makro
Dim Entscheidung As Integer
Entscheidung = MsgBox("Möchten Sie die nachfolgende festgelegte Priorisierung der Punkte vornehmen?" & vbNewLine & "1. Level" & vbNewLine & "2. Faktor", vbYesNo, "Priorisierung")
If Entscheidung = vbYes Then
Range("B3").Select
'Was muss hier stehen, damit ich in der Spalte Level sortieren kann nach "niedrig" "mittel" "hoch"
' Alle werte mit "hoch" sollen zuerst aufgeführt werden, dann "mittel", dann "niedrig"
'ActiveWorkbook.Worksheets("huhu").ListObjects( _
"Analyse").Sort.SortFields.Add2 Key:=Range( _
"Test[Level]"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
'Level = Hoch, mittel, niedrig
'Anschließend soll dann in der Spalte Faktor absteigend nach Zahlen sortiert werden.
ActiveWorkbook.Worksheets("huhu").ListObjects( _
"Analyse").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("huhu").ListObjects( _
"Analyse").Sort.SortFields.Add2 Key:=Range( _
"Test[Faktor]"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
'Faktor = Zahl von 1-25
'Ergebnis als BSP
' hoch 25
' hoch 22
' hoch 19
' mittel 16
' mittel 16
' mittel 15
' niedrig 12
' niedrig 12
With ActiveWorkbook.Worksheets("huhu").ListObjects( _
"Analyse").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Zeilenhöhe anpassen
ActiveSheet.Range("A8:A2000").Rows.EntireRow.AutoFit
'Zoom auf 100%, damit Zeilenhöhe korrekt angezeigt wird
ActiveWindow.Zoom = 100
Else
End If
End Sub