Cijfers husselen.

[Eflux]

L.S.,
Hoe kan ik in Excel een reeks cijfers door elkaar "husselen".
In de cijferreeks komen een aantal groepen cijfers van gelijke waarde voor.
Bvd.
Eflux

 

[robdgr]

Eflux,

Post hier eens een voorbeeldje met een paar getallen.

Groet,

 

[Wigi]

Zet je getallen in 1 rij of kolom. Voer dan deze macro uit.

Option Explicit
Option Base 1

Sub DoorElkaarHusselen()
    Dim iArr As Variant, i As Integer, r As Integer, temp As Integer, rng As Range, Cnt As Integer
    
    Set rng = Application.InputBox("Duid de getallen aan.", "Gegevens", Selection.Address, Type:=8)
    If WorksheetFunction.Min(rng.Rows.Count, rng.Columns.Count) > 1 Or rng Is Nothing Then Exit Sub
    
    Cnt = WorksheetFunction.Count(rng)
    
    ReDim iArr(1 To Cnt)
    For i = 1 To Cnt
        iArr(i) = rng.Cells(i)
    Next i
    
    For i = Cnt To 2 Step -1
        r = Int(Rnd() * Cnt) + 1
        temp = iArr(r)
        iArr(r) = iArr(i)
        iArr(i) = temp
    Next i
    
    If rng.Rows.Count = 1 Then rng.Offset(1) = iArr
    If rng.Columns.Count = 1 Then rng.Offset(, 1) = WorksheetFunction.Transpose(iArr)
End Sub

Wigi

 

[Eflux]

Zet je getallen in 1 rij of kolom. Voer dan deze macro uit.

Option Explicit
Option Base 1

Sub DoorElkaarHusselen()
    Dim iArr As Variant, i As Integer, r As Integer, temp As Integer, rng As Range, Cnt As Integer
    
    Set rng = Application.InputBox("Duid de getallen aan.", "Gegevens", Selection.Address, Type:=8)
    If WorksheetFunction.Min(rng.Rows.Count, rng.Columns.Count) > 1 Or rng Is Nothing Then Exit Sub
    
    Cnt = WorksheetFunction.Count(rng)
    
    ReDim iArr(1 To Cnt)
    For i = 1 To Cnt
        iArr(i) = rng.Cells(i)
    Next i
    
    For i = Cnt To 2 Step -1
        r = Int(Rnd() * Cnt) + 1
        temp = iArr(r)
        iArr(r) = iArr(i)
        iArr(i) = temp
    Next i
    
    If rng.Rows.Count = 1 Then rng.Offset(1) = iArr
    If rng.Columns.Count = 1 Then rng.Offset(, 1) = WorksheetFunction.Transpose(iArr)
End Sub

Wigi

Bedankt, we zullen een en ander uitproberen.Mijn oudste zoon zal ik maar aan het werk zetten zodat hij zijn "probleem" maar zelf moet oplossen
Ik ga ervan uit dat mijn vraag opgelost is.
Grtz Eflux

 

[Wigi]

Ik ga ervan uit dat mijn vraag opgelost is.
Grtz Eflux

Ik vermoed het ook, als het niet is vraag dan maar weer.

 

[Eflux]

Ik vermoed het ook, als het niet is vraag dan maar weer.

Hoi WIGI,
Mijn zoon heeft jouw "macrootje" overgenomen en het werkt uit de kunst.:thumb:
Bedankt.
PS ik denk dat ik mij maar als lid ga opgeven, voor de contributie hoef ik het niet te laten

 

[Wigi]

Hoi WIGI,
Mijn zoon heeft jouw "macrootje" overgenomen en het werkt uit de kunst.:thumb:
Bedankt.

Ik vond het zelf ook één van mijn betere posts van de laatste dagen

Misschien kunnen de bestandjes op mijn site jou of jouw zoon nog wat meer aan het Excellen krijgen Bekijk ze maar gerust eens en kijk of er iets van je gading tussen zit. And there's more to come.

Groeten

Wigi

 

[huijb]

Vraag van SPHINX84 is verplaatst naar hier http://www.helpmij.nl/forum/showthread.php/794265-willekeurige-4-cijferige-nummer