Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1804to1808
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

abwechselndes Sortieren

abwechselndes Sortieren
22.01.2021 11:34:26
vba_hans
Hallo Leute,
ich hatte im Dezember schon mal um Hilfe gebeten um einen Code abwechselnd aufsteigend und absteigend zu sortieren.
Worti hat mir hierzu einen Codevorschlag geantwortet der wunderbar funktioniert. (Danke nochmals an Worti!)
Ich habe nun zusätzlich das Problem, dass vor diesem Code (in der Zelle davor - Spalte 1) ein Name steht der dann der Sortierung des Codes folgen soll.
Zurzeit wird nur die Spalte 2 mit den Codes sortiert aber die Namen davor bleiben in der gleichen Reihenfolge.
Könnte mir hier jemand helfen den VBA-Code von Worti so zu gestalten, dass die Namen der Sortierung folgen?
Sub Sortieren()
Dim lastrow As Double
Dim lngRow As Long
Dim lngStart As Long
Dim lngEnde As Long
Dim bolSortDirAsc As Boolean
lastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "G").End(xlUp).Row
Range(Cells(4, 1), Cells(lastrow, 26)).Sort Key1:=Range("G" & "1"), _
Order1:=xlDescending, Header:=xlNo
lngRow = 1
bolSortDirAsc = True
Do Until Cells(lngRow, 2).Value = ""
lngStart = lngRow
Do Until Not Mid(Cells(lngRow, 2).Value, 2, 1) = Mid(Cells(lngRow + 1, 2).Value, 2, 1)
lngRow = lngRow + 1
Loop
lngEnde = lngRow
If bolSortDirAsc Then
MySort lngStart, lngEnde, "Asc"
Else
MySort lngStart, lngEnde, "Desc"
End If
lngRow = lngRow + 1
bolSortDirAsc = Not bolSortDirAsc
Loop
End Sub

Function MySort(lngStart As Long, lngEnde As Long, sortDir As String)
Dim lngZeile As Long
Dim lngZeile2 As Long
Dim merkInhalt
If sortDir = "Asc" Then
For lngZeile = lngStart To lngEnde
For lngZeile2 = lngZeile To lngEnde
If Mid(Cells(lngZeile, 2).Value, 3, 3) > Mid(Cells(lngZeile2, 2).Value, 3, 3)  _
Then
merkInhalt = Cells(lngZeile, 2).Value
Cells(lngZeile, 2).Value = Cells(lngZeile2, 2).Value
Cells(lngZeile2, 2).Value = merkInhalt
End If
Next lngZeile2
Next lngZeile
Else
For lngZeile = lngStart To lngEnde
For lngZeile2 = lngZeile To lngEnde
If Mid(Cells(lngZeile, 2).Value, 3, 3) 

LG Hans

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: abwechselndes Sortieren
22.01.2021 11:42:03
onur

Range(Cells(4, 1), Cells(lastrow, 25);Cells(4, 1), Cells(lastrow, 26)).Sort Key1......

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige