VBA igjen?

[Ikke syk no]

Sliter med å få tallet 6 opp i kolonne K ved siden av tallene som er der fra før?
Noen som kan rette opp makroen slik at det går?

 

 

 

Sub FørsteRundeTrekning()
    Dim Spillere() As Integer
    Dim i As Integer, AntallSpillere As Integer, Rad As Integer
    Dim Ark As Worksheet
    Dim TilfeldigRad As Integer
    
    ' Angi riktig arkfane
    Set Ark = ThisWorkbook.Sheets("Påmelding")
    
    ' Hent antall spillere fra celle D1
    AntallSpillere = Ark.Range("D1").Value
    
    ' Sjekk om det er gyldig antall spillere
    If AntallSpillere <= 0 Then
        MsgBox "Antall spillere i celle D1 må være større enn 0!", vbExclamation
        Exit Sub
    End If
    
    ' Slett innhold i relevante celler (kolonner I, J, K)
    For Rad = 4 To 28
        Ark.Cells(Rad, 9).ClearContents ' Kolonne I
        Ark.Cells(Rad, 10).ClearContents ' Kolonne J
        Ark.Cells(Rad, 11).ClearContents ' Kolonne K
    Next Rad
    
    ' Initialiser spillerlisten
    ReDim Spillere(1 To AntallSpillere)
    For i = 1 To AntallSpillere
        Spillere(i) = i
    Next i
    
    ' Shuffle spillerlisten tilfeldig
    Randomize
    Dim Temp As Integer, TilfeldigIndex As Integer
    For i = 1 To AntallSpillere
        TilfeldigIndex = Int((AntallSpillere - i + 1) * Rnd + i)
        Temp = Spillere(i)
        Spillere(i) = Spillere(TilfeldigIndex)
        Spillere(TilfeldigIndex) = Temp
    Next i
    
    ' Fordel spillere til kolonner I og J
    Rad = 4 ' Start fra rad 4
    Dim KolonneI As Integer, KolonneJ As Integer, KolonneK As Integer
    KolonneI = 9 ' Kolonne I (Sp1)
    KolonneJ = 10 ' Kolonne J (Sp2)
    KolonneK = 11 ' Kolonne K (Sp3)

    Dim OverskytendeSpillere() As Integer
    Dim AntallOverskytende As Integer
    AntallOverskytende = 0 ' Teller for overskytende spillere

    ' Fordel par (I og J)
    For i = 1 To AntallSpillere
        If Rad <= 28 Then
            ' Fyll kolonne I og J med et par
            Ark.Cells(Rad, KolonneI).Value = Spillere(i) ' Sp1
            If i + 1 <= AntallSpillere Then
                Ark.Cells(Rad, KolonneJ).Value = Spillere(i + 1) ' Sp2
                i = i + 1 ' Flytt til neste spiller i listen
            End If
            Rad = Rad + 1 ' Gå til neste rad
        Else
            ' Legg overskytende spillere i en liste
            AntallOverskytende = AntallOverskytende + 1
            ReDim Preserve OverskytendeSpillere(1 To AntallOverskytende)
            OverskytendeSpillere(AntallOverskytende) = Spillere(i)
        End If
    Next i

    ' Plasser overskytende spillere i kolonne K tilfeldig
    For i = 1 To AntallOverskytende
        Do
            TilfeldigRad = Int((7 - 4 + 1) * Rnd + 4) ' Velg en tilfeldig rad mellom 4 og 7
        Loop While Ark.Cells(TilfeldigRad, KolonneK).Value <> "" ' Finn en ledig rad i K
        Ark.Cells(TilfeldigRad, KolonneK).Value = OverskytendeSpillere(i) ' Plasser spiller som tredje person
    Next i
    
    MsgBox "Trekning for første runde er fullført!"
End Sub