Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1680to1684
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Sortierung nach Prio. - mit Ausnahme

VBA: Sortierung nach Prio. - mit Ausnahme
08.03.2019 11:36:54
Chris
Hallo Forum,
ich habe einen Code im Netz gefunden und ein bisschen auf meine Anforderung angepasst. Dieser priorisiert (schiebt die Zeilen nach oben) innerhalb meines Bereichs gemäß Eingabe in Spalte F die entsprechenden Zeile. Ich habe in Spalte F ein Dropdown per Datenüberprüfung mit Zahlen 1-5 und "X" angelegt.
Ich möchte nun, dass wenn "X" ausgewählt wird, das praktisch wie "kein Eintrag" gilt und die Sortierung nur auf Zahlen von 1-5 erfolgt.
Mein Code stellt zwar sicher, dass wenn ich "X" auswähle die entsprechende Zeile nicht sortiert wird, wenn ich aber zusätzlich in einer anderen Zeile eine Zahl wähle, wird die Zeile mit "X" auch automatisch mitverschoben. Ich möchte das aber nicht, nur die Zahlen sollen letztlich nach oben verschoben werden - als Symbolik für die Prio.
Mein Code ist folgender:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngIntersect As Range
Set rngIntersect = Application.Intersect(Range("A7:N500"), Target)
If Not rngIntersect Is Nothing Then
If ActiveWorkbook.Worksheets("DP").Cells(Target.Row, 6)  "X" Then
If ActiveWorkbook.Worksheets("DP").Cells(Target.Row, 1)  "" _
And ActiveWorkbook.Worksheets("DP").Cells(Target.Row, 2)  "" _
And ActiveWorkbook.Worksheets("DP").Cells(Target.Row, 3)  "" _
And ActiveWorkbook.Worksheets("DP").Cells(Target.Row, 4)  "" _
And ActiveWorkbook.Worksheets("DP").Cells(Target.Row, 5)  "" _
And ActiveWorkbook.Worksheets("DP").Cells(Target.Row, 7)  "" _
And ActiveWorkbook.Worksheets("DP").Cells(Target.Row, 14)  "" Then
With ActiveWorkbook.Worksheets("DP").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("F7:F500"), SortOn:=xlSortOnValues, Order:= _
xlAscending, _
DataOption:=xlSortNormal
.SortFields.Add Key:=Range("N7:N500"), SortOn:=xlSortOnValues, Order:= _
xlAscending, _
DataOption:=xlSortNormal
.SetRange Range("A7:O500")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
Else
End If
End If
End Sub
Wäre sehr dankbar wenn jemand mir bei der kleinen Anpassung helfen könnte, da ich relativ unbeholfen bin was VBA angeht.
Gruß und schon mal schönes Wochenende!
- Chris

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA: Sortierung nach Prio. - mit Ausnahme
08.03.2019 23:35:17
fcs
Hallo Chris,
mit der folgenden Modifikation werden erst alle Zeilen nach Spalte F sortiert.
Danach wird die 1.Zeile mit "X" gesucht und dann die Zeilen oberhalb nach Spalten F und N sortiert.
LG
Franz
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngIntersect As Range, ZeileX As Long
Set rngIntersect = Application.Intersect(Range("A7:N500"), Target)
If Not rngIntersect Is Nothing Then
If Me.Cells(Target.Row, 6)  "X" Then
If Me.Cells(Target.Row, 1)  "" _
And Me.Cells(Target.Row, 2)  "" _
And Me.Cells(Target.Row, 3)  "" _
And Me.Cells(Target.Row, 4)  "" _
And Me.Cells(Target.Row, 5)  "" _
And Me.Cells(Target.Row, 7)  "" _
And Me.Cells(Target.Row, 14)  "" Then
ZeileX = 500
With Me.Sort
.SortFields.Clear
.SortFields.Add Key:=Me.Range("F7"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Me.Range("A7:O" & ZeileX)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Set rngIntersect = Me.Range("F7:F500").Find(what:="X", LookIn:=xlValues, lookat:= _
xlWhole)
If Not rngIntersect Is Nothing Then
ZeileX = rngIntersect.Row
End If
If ZeileX > 9 Then
With Me.Sort
.SortFields.Clear
.SortFields.Add Key:=Me.Range("F7"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Me.Range("N7"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Me.Range("A7:O" & ZeileX - 1)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
End If
Else
End If
End If
End Sub

Anzeige
AW: VBA: Sortierung nach Prio. - mit Ausnahme
09.03.2019 08:29:54
Chris
Guten Morgen Franz,
zunächst vielen Dank für deine Hilfe!
Ich habe jetzt eben das Szenario in einer Bsp-Datei simuliert, da ich mich scheinbar nicht präzise genug ausgedrückt habe - tut mir Leid!
Letztlich möchte ich einfach nur, dass bei Eingabe in Spalte F eine Sortierung erfolgt, aber nur wenn Zahl von 1-5 eingegeben wird. Sobald ich "X" eingebe soll nichts passieren, also keine Sortierung.
Ich habe das in der Bsp-Datei jetzt auch mit "Soll" & "Ist" abgebildet.
Wäre dir sehr dankbar, wenn du/ihr mir nochmals helfen würdest, trotz meiner schlechten Formulierung.
https://www.herber.de/bbs/user/128243.xlsx
- Chris
Anzeige
AW: VBA: Sortierung nach Prio. - mit Ausnahme
10.03.2019 09:31:27
fcs
Hallo Chris,
schau mal ob es so passt.
LG
Franz
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngIntersect As Range, ZeileX As Long
Set rngIntersect = Application.Intersect(Range("A7:N500"), Target)
If Not rngIntersect Is Nothing Then
If Me.Cells(Target.Row, 6)  "X" Then
If Me.Cells(Target.Row, 1)  "" _
And Me.Cells(Target.Row, 2)  "" _
And Me.Cells(Target.Row, 3)  "" _
And Me.Cells(Target.Row, 4)  "" _
And Me.Cells(Target.Row, 5)  "" _
And Me.Cells(Target.Row, 7)  "" _
And Me.Cells(Target.Row, 14)  "" Then
With Me.Sort
.SortFields.Clear
.SortFields.Add Key:=Me.Range("F7"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Me.Range("N7"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Me.Range("A7:O500")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Set rngIntersect = Me.Range("F7:F500").Find(what:="X", LookIn:=xlValues, lookat:= _
xlWhole)
If Not rngIntersect Is Nothing Then
ZeileX = rngIntersect.Row
End If
If ZeileX > 7 And ZeileX 

Anzeige
AW: VBA: Sortierung nach Prio. - mit Ausnahme
10.03.2019 17:48:08
Chris
Hallo Franz,
jetzt klappt alles perfekt, vielen Dank Dir!
- Chris

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige