Sortieren laut Buchstaben

UdPa · 2024-10-08T19:29:13+00:00

Hallo Excelexperten Stehe wieder vor einem Problem. Ich hab eine Tabelle mit 4 verschiedenen Ligen erstellt. Jede Liga hat max. 9 Mannschaften. Es kann aber auch sein das in einer liga z.B nur 7 Mannschaften sind. Mein Problem ist das sortieren. Ist es möglich so zu Sortieren das alle A Mannschaften, alle B Mannschaften, usw. im richtigen Bereich stehen? Mit meiner Beispieldatei ist es sicher verständlich was ich will. Das heisst sind in der Liga A nur 8 Mannschaften dann bleibt die 9 te Zeile frei und B Mannschaften fangen dann eben erst im B Bereich an Vielen lieben Dank Hier meine Datei https://www.herber.de/bbs/user/172738.xlsm

Hi
du musst, wenn Mannschaften fehlen, für diese dann Dummy-Zeilen anlegen, in denen in Spalte B die Liga-Kennung steht und der rest leer ist.
dh du brauchst in der Liste immer 9x A, 9x B, 9x C und 9x D, dann kannst du du ganz normal sortieren.

das machst dieser Code.

Sub Sortiere_Mannschaften_nach_Liga()



Dim x As String

Dim L



'--- Fehlende Buchstaben ergeänzen

For Each L In Array("A", "B", "C", "D")

    Do Until WorksheetFunction.CountIf(Columns(2), L) >= 9

        Cells(2, 2).End(xlDown).Offset(1, 0) = L

    Loop

Next







'---Hier dann dein Code zum Sortieren (alte Programmierweise von Excel 2003, passt in eine Zeile

Range("B3:C38").Sort Key1:=Range("B3"), order1:=xlAscending, Header:=xlNo



End Sub

der erste Teil ergänzt die fehlenden Buchstaben, der zweite Teil sortiert dann
Gruß Daniel

Hallo,

sollte für deine Zwecke ausreichen:



Option Explicit



Sub LigenSortieren()

    Dim i&, j&, k&, iBlock&, arrList(), tmp(), arrLigen(): arrLigen = Array("a", "b", "c", "d")

    iBlock = 3

    With Tabelle4

        arrList = .Range("B3:C" & .Cells(Rows.Count, 3).End(xlUp).Row)

        .Range("B4:C38").ClearContents

        For i = 0 To UBound(arrLigen)

            For j = 1 To UBound(arrList)

                If arrLigen(i) = LCase(arrList(j, 1)) Then

                    k = k + 1

                    ReDim Preserve tmp(1 To 2, 1 To k)

                    tmp(1, k) = arrList(j, 1)

                    tmp(2, k) = arrList(j, 2)

                End If

            Next j

            tmp = Application.Transpose(tmp)

            QuickSort LBound(tmp), UBound(tmp), tmp, 2

            .Cells(iBlock, 2).Resize(UBound(tmp, 1), UBound(tmp, 2)) = tmp

            iBlock = iBlock + 9

            k = 0

            Erase tmp

        Next i

    End With

End Sub



Private Sub QuickSort(lngLBound As Long, lngUBound As Long, avntArray As Variant, lngSortColumn As Long)

    Dim lngIndex1 As Long, lngIndex2 As Long, lngColumn As Long

    Dim vntBuffer As Variant, vntTemp As Variant

    lngIndex1 = lngLBound

    lngIndex2 = lngUBound

    vntTemp = avntArray((lngLBound + lngUBound) \ 2, lngSortColumn)

    Do

        Do While avntArray(lngIndex1, lngSortColumn)  vntTemp

            lngIndex1 = lngIndex1 + 1

        Loop

        Do While vntTemp  avntArray(lngIndex2, lngSortColumn)

            lngIndex2 = lngIndex2 - 1

        Loop

        If lngIndex1 = lngIndex2 Then

            For lngColumn = LBound(avntArray, 2) To UBound(avntArray, 2)

                vntBuffer = avntArray(lngIndex1, lngColumn)

                avntArray(lngIndex1, lngColumn) = avntArray(lngIndex2, lngColumn)

                avntArray(lngIndex2, lngColumn) = vntBuffer

            Next

            lngIndex1 = lngIndex1 + 1

            lngIndex2 = lngIndex2 - 1

        End If

    Loop Until lngIndex1 > lngIndex2

    If lngLBound  lngIndex2 Then Call QuickSort(lngLBound, lngIndex2, avntArray, lngSortColumn)

    If lngIndex1  lngUBound Then Call QuickSort(lngIndex1, lngUBound, avntArray, lngSortColumn)

End Sub

Gruß Uwe

Forumthread: Sortieren laut Buchstaben

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Sortieren laut Buchstaben

Forumthread: Sortieren laut Buchstaben

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread