• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Random volgende rijen invullen

Status
Niet open voor verdere reacties.
Tja,
eerst ging het om een tabel met 4 kolommen, nu zijn het er ineens 8 geworden.
Vrijwel elk bericht van jou MrBob, roept nieuwe vragen op.
 
Ga nu niet naar die 8 rijen kijken :confused: tis alleen maar om duidelijk te maken als ik met de code die ik nodig heb door ga wat de uitkomst moet zou zijn, AatB heeft het bijna voor elkaar alleen in kolom 2 gaat het verkeerd er worden er teveel 4 gebruikt maar kolom 3 en 4 gaan goed. :confused:

Zucht, ik ga het dan maar opgeven, jammer dat het niet lukt. :( en ga nu niet zeggen dat het aan mijn uitleg ligt want ik krijg het gevoel dat jullie er zelf een spelletje van maken en jullie het je zelf moeilijk maken. Maar toch nog bedankt alle en een noot voor Aatb kijk even naar mijn rijen.xlsm die ik aan de post heb gehangen 2de kolom komen 2 x een 4 voor en dat zou maar 1 maal moeten kunnen voorkomen omdat ik maar 1 x een 4 heb opgegeven, als je dit krijgt opgelost ben ik allang tevreden. ;)

Mvg, MrBob
 
Nog een keertje......

Alle getallen (dus ook de dubbele) in kolom 1 worden eenmalig random gebruikt om kolom 2,3 & 4 te vullen.
Getal in een cel is ongelijk aan de cel links er naast.
Bij geen mogelijke keuze wordt een 1 ingevuld.


Code: 
Sub FillCells()
    
    On Error GoTo errlog
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    
    
    Columns("B:G").ClearContents
    
    Set Rng = Cells(5, 1).CurrentRegion
    mx = WorksheetFunction.Max(Rng.Columns(1))
    rw = Rng.Rows.Count
    
    tmp = 0
    nLoop = 100
    
    For Each c In Rng.Columns(1).Cells
        
        If c = "Vrij" Or c < 1 Then GoTo nxt
        
        CntLoop = 0
        While CntLoop < nLoop
            CntLoop = CntLoop + 1
            tmp1 = Int((rw * Rnd(1)) + 1)
            
            If Rng.Cells(tmp1, 1) = "Vrij" Then
                GoTo col2
            End If
            
            If Rng.Cells(tmp1, 5) = "" Then
                If Rng.Cells(tmp1, 1) = c.Offset(-1, 2) Or _
                   Rng.Cells(tmp1, 1) = c.Offset(0, 0) Then
                    GoTo col2
                Else
                    c.Offset(0, 1) = Rng.Cells(tmp1, 1)
                    Rng.Cells(tmp1, 5) = "x"
                    GoTo nxtcol3
                End If
            Else
                GoTo col2
            End If
col2:
        Wend
        If CntLoop = nLoop Then
            c.Offset(0, 1) = 1
        End If
     
nxtcol3:
        CntLoop = 0
        While CntLoop < nLoop
            CntLoop = CntLoop + 1
            tmp1 = Int((rw * Rnd(1)) + 1)
            
            If Rng.Cells(tmp1, 1) = "Vrij" Then
                GoTo col3
            End If
            
            If Rng.Cells(tmp1, 6) = "" Then
                If Rng.Cells(tmp1, 1) = c.Offset(-1, 2) Or _
                    Rng.Cells(tmp1, 1) = c.Offset(0, 1) Then
                    GoTo col3
                Else
                    c.Offset(0, 2) = Rng.Cells(tmp1, 1)
                    Rng.Cells(tmp1, 6) = "x"
                    GoTo nxtcol4
                End If
            Else
                GoTo col3
            End If
col3:
        Wend
        If CntLoop = nLoop Then
            c.Offset(0, 2) = Rng.Cells(tmp1, 1)
        End If
        
nxtcol4:
        CntLoop = 0
        While CntLoop < nLoop
            CntLoop = CntLoop + 1
            tmp1 = Int((rw * Rnd(1)) + 1)
            
            If Rng.Cells(tmp1, 1) = "Vrij" Then
                GoTo col4
            End If
            
            If Rng.Cells(tmp1, 7) = "" Then
                If Rng.Cells(tmp1, 1) = c.Offset(-1, 3) Or _
                    Rng.Cells(tmp1, 1) = c.Offset(0, 2) Then
                    GoTo col4
                Else
                    c.Offset(0, 3) = Rng.Cells(tmp1, 1)
                    Rng.Cells(tmp1, 7) = "x"
                    GoTo nxt
                End If
            Else
                GoTo col4
            End If
col4:
        Wend
        If CntLoop = nLoop Then
            c.Offset(0, 3) = 1
        End If
        
nxt:
    Next
    
    Columns("E:G").ClearContents
        
errlog:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
    End With
        

End Sub
 
@Aatb, Je bent mijn held, zo werkt het bijna voortreffelijk. :thumb:

Enige voorwaarde die nog niet werkt is dat als er een 4 staat er alleen een 3 en of 2 zou kunnen volgen, maar uit de enigzins negatieve berichten begrijp ik dat dat een illusie is die niemand voor mekaar kan krijgen en daarom ga ik nu deze vraag op opgelost zetten. Aatb nogmaals bedankt je hebt me een heel eind op weg geholpen en ik kan weer verder met mijn project en later als ik weer wat vrije tijd heb je code gaan ontrafelen van hoe je het een en ander voor mekaar gekregen hebt. :thumb:
 
Nog even een sorteerslag toegevoegd op kolom 1.

Code: 
Sub FillCells()
    
    On Error GoTo errlog
    
' Alles wat enige vertraging kan opleveren wordt hier uitgezet.

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    
    
    Columns("B:G").ClearContents
    
    'Tabel begint op kolom A, rij 5
    Set Rng = Cells(5, 1).CurrentRegion
    mx = WorksheetFunction.Max(Rng.Columns(1))
    rw = Rng.Rows.Count
    
    tmp = 0
    nLoop = 100 'Na 100 keer geen resultaat wordt een 1 geplaatst
    
    
    For Each c In Rng.Columns(1).Cells
        
        If c = "Vrij" Or c < 1 Then GoTo nxt
        
        CntLoop = 0
        While CntLoop < nLoop
            CntLoop = CntLoop + 1
            tmp1 = Int((rw * Rnd(1)) + 1)
            
            If Rng.Cells(tmp1, 1) = "Vrij" Then
                GoTo col2
            End If
            
            If Rng.Cells(tmp1, 5) = "" Then
                If Rng.Cells(tmp1, 1) = c.Offset(-1, 2) Or _
                   Rng.Cells(tmp1, 1) = c.Offset(0, 0) Then
                    GoTo col2
                Else
                    c.Offset(0, 1) = Rng.Cells(tmp1, 1)
                    Rng.Cells(tmp1, 5) = "x"
                    GoTo nxtcol3
                End If
            Else
                GoTo col2
            End If
col2:
        Wend
        If CntLoop = nLoop Then
            c.Offset(0, 1) = 1
        End If
     
nxtcol3:
        CntLoop = 0
        While CntLoop < nLoop
            CntLoop = CntLoop + 1
            tmp1 = Int((rw * Rnd(1)) + 1)
            
            If Rng.Cells(tmp1, 1) = "Vrij" Then
                GoTo col3
            End If
            
            If Rng.Cells(tmp1, 6) = "" Then
                If Rng.Cells(tmp1, 1) = c.Offset(-1, 2) Or _
                    Rng.Cells(tmp1, 1) = c.Offset(0, 1) Then
                    GoTo col3
                Else
                    c.Offset(0, 2) = Rng.Cells(tmp1, 1)
                    Rng.Cells(tmp1, 6) = "x"
                    GoTo nxtcol4
                End If
            Else
                GoTo col3
            End If
col3:
        Wend
        If CntLoop = nLoop Then
            c.Offset(0, 2) = Rng.Cells(tmp1, 1)
        End If
        
nxtcol4:
        CntLoop = 0
        While CntLoop < nLoop
            CntLoop = CntLoop + 1
            tmp1 = Int((rw * Rnd(1)) + 1)
            
            If Rng.Cells(tmp1, 1) = "Vrij" Then
                GoTo col4
            End If
            
            If Rng.Cells(tmp1, 7) = "" Then
                If Rng.Cells(tmp1, 1) = c.Offset(-1, 3) Or _
                    Rng.Cells(tmp1, 1) = c.Offset(0, 2) Then
                    GoTo col4
                Else
                    c.Offset(0, 3) = Rng.Cells(tmp1, 1)
                    Rng.Cells(tmp1, 7) = "x"
                    GoTo nxt
                End If
            Else
                GoTo col4
            End If
col4:
        Wend
        If CntLoop = nLoop Then
            c.Offset(0, 3) = 1
        End If
        
nxt:
    Next
    

    'Sorteren van de tabel

    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Rng.Cells(1, 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Rng
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
    Columns("E:G").ClearContents
        
errlog:
    'Alles wordt weer aangezet.
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
    End With
        

End Sub
 
Geldt die 2 of 3 alleen voor de 4 in kolom 1 en moet dus alleen de waarde in kolom 2 gecontroleerd worden?
En als alle 2-en en 3-en al gebruikt zijn dan een ander getal uit kolom 1?
Of wil je de 4-en met voorrang eerst afhandelen?
 
Dit moet dus in elke kolom worden gecontroleerd.

1 kan 4 en 2 worden
2 kan 1 en 3 worden
3 kan 4 en 2 worden
4 kan 3 en 2 worden
 
Laatst bewerkt:
Hi MrBob,

ook ik raak hier het spoor bijster.
Probeer het maar zelf door de laatste code aan te passen.

mvg,

Aat
 
Aat geen probleem heb het zelf al opgelost met je laatste code, was een quick fix en het werkt nu voortreffelijk bedankt voor al je hulp en geduld dat sommige andere niet hadden. Op naar de volgende vraag. :thumb:

Case closed. ;)
 
Als je dan ook nog zo vriendelijk wil zijn om de ongeduldigen het uiteindelijke resultaat te laten zien. Dan kunnen ook wij ervan leren. Alvast dank voor de genomen moeite.
 
MrBob zei:
Aat geen probleem heb het zelf al opgelost met je laatste code, was een quick fix en het werkt nu voortreffelijk bedankt voor al je hulp en geduld dat sommige andere niet hadden. Op naar de volgende vraag. :thumb:

Case closed. ;)
Klik om te vergroten...

geduld dat sommige andere niet hadden?
Je hebt je vraag binnen 24uur opgelost.
Je hebt geluk dat het weekend is en niet een doordeweekse werkdag.
Bovendien antwoorden de meesten hier gratis en voor niks.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan