[VBA] Αυτόματη καταχώρηση τυχαίων αριθμών σε μια στήλη

[Tasos]

Στο παράδειγμα αυτό, με την μακροεντολή (MixNumbers) καταχωρούνται τυχαίοι μοναδικοί αριθμοί στην περιοχή A2:A...μέχρι το τελευταίο κελί με περιεχόμενα της στήλης Α:

Option Explicit

Sub MixNumbers()
    Dim rng As Range, StartNumber As Long, EndNumber As Long
    Set rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)) ' Ορισμός της περιοχής  A2:A...μέχρι το τελευταίο κελί...
    StartNumber = 10 ' Το αρχικό νούμερο
    EndNumber = rng.Count + StartNumber -1 ' Το πλήθος των κελιών
    rng.Value = Application.Transpose(MixArray(StartNumber, EndNumber))
    ' Προσοχή! Η μέθοδος Transpose() υποστηρίζει πίνακες (Array) που τα στοιχεία τους δεν υπερβαίνουν τα 65.536
End Sub

Function MixArray(LngMin As Long, LngMax As Long) As Variant
    Dim i As Long, x As Double, rng As Long, Itm As Long
    ReDim xKeys(LngMin To LngMax)
    For i = LngMin To LngMax 
        xKeys(i) = i + 1
    Next
    rng = LngMax - LngMin + 1
    For i = LngMin To LngMax
        x = Int(Rnd * rng) + i
        Itm = xKeys(x)
        xKeys(x) = xKeys(i)
        xKeys(i) = Itm
        rng = rng - 1
    Next
    MixArray = xKeys
End Function