Lege rijen toevoegen en nummer toekennen

[Hans04]

Hallo allen,

Ik doe graag een beroep op jullie kennis.
Ik ben al jaren bezig als planner voor een groot zaalvoetbaltoernooi. Daarbij doet zich soms een probleem voor m.b.t. de ranking voor play-off in de verschillende "ongelijke" poules. Dat probleem is inmiddels getackeld en geautomatiseerd. Mede dank zij dit forum.
Nu probeer ik nog wat meer te automatiseren, door de output van het gebruikte programma uniform te maken, zodat het ieder jaar weer kan worden gebruikt.
De grootte en het aantal poules is ieder jaar (tot het laatste moment) weer onvoorspelbaar. De output van het gebruikte programma is afhankelijk daarvan.
Nu wil ik graag daar waar de poules minder groot zijn dan 10, dit aanvullen met extra regels tot 10 en dan ook meteen de ontbrekende nummers er in zetten.
Als voorbeeld stuur ik 2 bestanden mee.
Het 1e bestand, stand.xls is een voorbeeld van de output zoals ik die krijg.
Het 2e bestand, stand_10.xls is zoals ik het graag zou willen hebben.

Ik ben al wat een het proberen geweest, maar kom er vooralsnog niet echt uit.
Iemand een idee wat ik zou kunnen doen om de gewenste layout te realiseren met een formule of VBA?

Vriendelijke groet,
Hans

 

[VenA]

Probeer het eens met deze

Sub VenA()
Application.ScreenUpdating = False
With Sheets("S")
    For Each cl In .Range("E4:E" & (Application.CountIf(.Columns(5), "stand") * 12) + 2)
        If LCase(cl.Value) = "stand" Then
            For j = 1 To 10
                If cl.Offset(j, -1).Value = "" Then
                    cl.Offset(j, -1).Rows.EntireRow.Insert
                    cl.Offset(j, -1).Value = j
                End If
            Next j
        End If
    Next cl
End With
End Sub

 

[edmoor]

Wel even ScreenUpdating weer aan zetten. Anders zie je nog geen resultaat

 

[VenA]

't is wat met de screenupdating. Waarom is de default eigenlijk geen FALSE? Er zit toch niemand te wachten op heen en weer 'geflikker' op een scherm.:d

 

[Hans04]

De oplossing die VenA aangedragen heeft, werkt inderdaad zoals ik voor ogen had.
Ga nu eerst proberen om hem vanuit een andere procedure in een andere worksheet aan te sturen. Andere sheet is mijn basismodule.
Edmoor, ik had de opdracht ScreenUpdating er al in gezet.

Moet tevens, in de andere procedure nog een controle inbouwen om te zien of het bestand stand.xls wel aanwezig is én een regel in die procedure maken, waarbij een bericht van overschrijven van data wel is toegestaan.

Vast bedankt voor de aangedragen oplossing.

gr. Hans

 

[snb]

Zonder screenupdating:

Sub M_snb()
    With Columns(3).SpecialCells(4)
        For j = .Areas.Count To 2 Step -1
           .Areas(j).Offset(-1).Resize(12, 9).Cut Cells(3 + 12 * (j - 2) + 2 * Abs(j > 4), 3)
        Next
    End With

    Range("A33:B34").Cut Cells(39, 1)
End Sub

PS. omdat geen gebruiker zo snel is, dat er veel 'geflikker' te zien is.

 

[Hans04]

snb, bedankt voor je snelle reactie.
De oplossing die jij geeft, werkt inderdaad razendsnel, maar de oplossing van VenA vult de lege regels ook meteen op met de dan ontbrekende getallen t/m 10.
Als jouw code per ongeluk 2x achter elkaar wordt uitgevoerd, wordt de inhoud van regel 39 en 40 gewist.
Er mogen geen regels worden gewist.


Groet,
Hans

 

[snb]

De code is niet bedoeld om per ongeluk 2 keer achter elkaar te worden uitgevoerd.
Mijn code wist geen enkele regel.
Het aanvullen van getallen lijkt me een leuk klusje voor de vragensteller....

 

[Hans04]

snb, Dat uitzoeken hoe ik getallen kan toevoegen is een uitdaging voor mij. Ik ben niet zo goed bekend met VBA, maar kom een heel eind door te lezen en uit te testen.

Ik zie al waar de schoen wringt, als de code via een macro-opdracht per ongeluk 2x wordt uitgevoerd.
In jouw code is een vaste waarde opgenomen. A33:B34 wordt geknipt en weer geplakt op A39. Bij een 2e keer uitvoeren wordt de waarde dan overschreven door de dan "lege" cellen A33:B34.

 Range("A33:B34").Cut Cells(39, 1)

Bij mijn vraagstelling had ik al aangegeven, dat het aantal poules en categorieën iedere keer verschillend is. Zij komen dus steeds op andere posities te staan. Daarom kan deze code niet zonder meer worden uitgevoerd op een uitkomst bij meerdere (of mindere) aantallen categorieën/poules.

De eerder door VenA gegeven oplossing werkt wel iets trager, maar voldoet in elk geval aan mijn verwachtingen.
En dat voor een schema met 24 poules, 4 categorieën (met ruim 200 teams).

Ik ben zeer tevreden en dankbaar voor de geboden oplossingen. De oplossing van snb geeft wel stof tot nadenken en uittesten. Uitdaging :d

Vriendelijke groet,
Hans

 

[snb]

Als je de struktuur vereenvoudigt maak je het jezelf een stuk makkelijker:
Voor een onbeperkt aantal groepen:

Sub M_snb()
    With Blad1.Columns(3).SpecialCells(4)
        For j = .Areas.Count To 2 Step -1
           .Areas(j).Offset(-1).Resize(12, 9).Cut Cells(3 + 12 * (j - 2), 3)
        Next
    End With
    
    For Each ar In Blad1.Columns(4).SpecialCells(2).Areas
       If ar.Rows.Count < 10 Then ar.AutoFill ar.Resize(10)
    Next

    Columns(3).Find(" A", Cells(4, 3)).Offset(, -1) = "Dames"
End Sub