Αυτόματη καταχώρηση τυχαίων αριθμών σε μια στήλη
Στο παράδειγμα αυτό, με την μακροεντολή (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
| 