Sorteren blokken rijen.

[fwalraven]

Het commentaar "''Verwijder eventuele punten, komma,s enof spaties." klopt niet, alleen punten worden verwijderd. En beide regels code doen precies hetzelfde:

Sheets("Gesorteerd").Range("A1").Resize(UBound(a), 6) = b
Sheets("Gesorteerd").Range("A1").Resize(UBound(b, 1), UBound(b, 2)) = b

En je vertelt niet welke foutmelding je krijgt.

Inderdaad, beide regels doen het nu wel goed.????

Wat de foutmelding was, weet ik niet meer.
Ik vermoed: Compileerfout, een variabele is niet gedefinieerd.
Maar dat is echt een gok.
Ik weet alleen dat die regel geel gearceerd was.

Via de vraag aan DeepSeek, wat is er fout aan: Sheets("Gesorteerd").Range("A1").Resize(UBound(a), 6) = b
Kreeg ik meerdere mogelijkheden die de oorzaak konden zijn, oa: Sheets("Gesorteerd").Range("A1").Resize(UBound(b, 1), UBound(b, 2)) = b[

Na die regel aangepast te hebben ging het wel goed.

 

[fwalraven]

Beetje meer snelheid in de code kan geen kwaad.

Heb er twee codes in staan.
De eerste schrijft per blok weg en is daarmee iets sneller, maar geen test op snelheid met meerdere blokken.
Het blad 'Sorteer' is hierbij niet nodig.

HSV,
Ik waardeer het zeer zeker dat u mee denkt aan een oplossing.
Maar ik blijf bij de oplossing van AHulpje.
Frans

 

[AHulpje]

@HSV
Ik denk dat TS daar heel blij mee is, 0,0078 sec in plaats van 0,0234 sec.! Dan kan hij de macro 128 keer per seconde uitvoeren i.p.v. slechts 42 keer.

 

[HSV]

@AHulpje ,
Het is meer iets ter lering van denk ik zo (ook voor jou) i.p.v. ChatGPT te raadplegen.
Inlezen en wegschrijven in een array.

 

[AHulpje]

@HSV
Er is geen letter ChatGPT aan te pas gekomen en ik was er echt van overtuigd dat a en b in mijn code array's waren. Maar ik moet wel zeggen dat jouw code zeker niet verkeerd is.

 

[HSV]

Ik heb je wel iets betere codes zien schrijven toch?
Onderstaand stuk code wordt niet weggeschreven als array en de sorteermethode lijkt mij niet echt het werk van jou.

With Sheets("Sorteer")
        .Cells(r, 1) = a(1, 1)
        .Cells(r, 2) = a(1, 2)
        .Cells(r, 3) = 1
        For i = 1 To UBound(a)
            If a(i, 1) = "" Then
                r = r + 1
                .Cells(r, 1) = a(i + 1, 1)
                .Cells(r, 2) = a(i + 1, 2)
                .Cells(r, 3) = i + 1
                .Cells(r - 1, 4) = i - 1
            End If
        Next
        .Cells(r, 4) = i - 1
        With .Sort
            .SortFields.Clear
            .SortFields.Add2 Key:=Range("A:A")
            .SortFields.Add2 Key:=Range("B:B")
            .SetRange Range("A:D")
            .Apply
        End With
        j = -1

 

[AHulpje]

Ik had natuurlijk gebruik kunnen maken van Shellsort, Quicksort, Bubblesort of Mergesort uit mijn functiebibliotheek maar heb gekozen voor de sorteermogelijkheden van Excel, gewoon, omdat het kan. En ach, die maximaal tien rijtjes die ik aanmaak op het werkblad Sorteer had ik natuurlijk eerst in een array-tje kunnen zetten en daarna op het werkblad om ze door Excel te laten sorteren, maar dat had wat extra regels code vereist en ik ben liever lui dan moe. En vraag maar eens aan ChatGPT om sorteercode te schrijven, dan komt zij gegarandeerd niet met

With .Sort
   .SortFields.Clear
   .SortFields.Add2 Key:=Range("A:A")
   .SortFields.Add2 Key:=Range("B:B")
   .SetRange Range("A:D").Apply
End With

 

[HSV]

Ik zou het niet weten.

Om je luiheid te bevorderen.

.Cells(1).CurrentRegion.Sort .Cells(1), , .Cells(1, 2), , , , 2