Δημιουργήστε μια λίστα με μοναδικούς τυχαίους αριθμούς χρησιμοποιώντας VBA στο Microsoft Excel

Πίνακας περιεχομένων

Σε αυτό το άρθρο, θα δημιουργήσουμε μια προσαρμοσμένη συνάρτηση για τη δημιουργία μιας λίστας μοναδικών και τυχαίων αριθμών μεταξύ των καθορισμένων εύρων.

Σε αυτό το παράδειγμα, μπορούμε να εκτελέσουμε τη μακροεντολή κάνοντας κλικ στο κουμπί "Υποβολή". Πριν από την εκτέλεση της μακροεντολής, πρέπει να εισαγάγουμε τιμές για τέσσερις παραμέτρους. Έχουμε τη χαμηλότερη οριακή τιμή στο κελί C12, το ανώτατο όριο στο κελί C13, τον αριθμό των μοναδικών τυχαίων που απαιτούνται στο κελί C14 και τη διεύθυνση προορισμού, όπου απαιτείται έξοδος στο κελί C15.

Λογική εξήγηση

Δημιουργήσαμε την προσαρμοσμένη συνάρτηση "UniqueRandomNumbers" για να δημιουργήσουμε μια λίστα με μοναδικούς και τυχαίους αριθμούς. Αυτή η συνάρτηση λαμβάνει τον απαιτούμενο αριθμό, κατώτατο όριο και ανώτερο όριο ως παραμέτρους εισόδου.

Δημιουργήσαμε τη μακροεντολή "TestUniqueRandomNumbers" για να καλέσουμε την προσαρμοσμένη λειτουργία "UniqueRandomNumbers". Αυτή η μακροεντολή εκτελείται κάνοντας κλικ στο κουμπί "Υποβολή". Αυτή η μακροεντολή παίρνει την τιμή εισόδου χρήστη από το εύρος C12 έως C15.

Επεξήγηση κώδικα

i = CLng (Rnd () * (ULimit - LLimit) + LLimit)

Ο παραπάνω τύπος χρησιμοποιείται για τη δημιουργία του τυχαίου αριθμού μεταξύ του καθορισμένου άνω και κάτω ορίου. Η συνάρτηση Rnd () δημιουργεί έναν τυχαίο αριθμό μεταξύ 0 και 1.

Εύρος (Επιλογή, Επιλογή. Μετατόπιση (Μετρητής - 1, 0)). Τιμή = _

Application.Transpose (RandomNumberList)

Ο παραπάνω κώδικας χρησιμοποιείται για τη μεταφορά της εξόδου του πίνακα και την εκχώρηση της εξόδου στον καθορισμένο προορισμό.

Ακολουθήστε παρακάτω για τον κωδικό

 Option Explicit Function UniqueRandomNumbers (NumCount As Long, LLimit As Long, ULimit As Long) As Variant 'Declaing variables Dim RandColl As Collection Dim i As Long Dim varTemp () As Long' Έλεγχος επικύρωσης για την τιμή που καθορίζεται από τον χρήστη Εάν NumCount ULimit Τότε UniqueRandomNumbers = "Το καθορισμένο κατώτατο όριο είναι μεγαλύτερο από το καθορισμένο ανώτατο όριο" Έξοδος από τη Λειτουργία Τέλος Εάν Εάν NumCount> (ULimit - LLimit + 1) Τότε UniqueRandomNumbers = "Ο αριθμός των απαιτούμενων μοναδικών τυχαίων αριθμών είναι μεγαλύτερος από τον μέγιστο αριθμό μοναδικού αριθμού που μπορεί να υπάρχει μεταξύ του χαμηλότερου όριο και ανώτερο όριο "Έξοδος Λειτουργία Τέλος Αν" Δημιουργία νέου αντικειμένου συλλογής Ρύθμιση RandColl = Νέα συλλογή Τυχαία εκτέλεση σφάλματος Συνέχιση επόμενου "Υπολογισμός του τυχαίου αριθμού που υπάρχει μεταξύ του κατώτερου και του άνω ορίου i = CLng (Rnd () * (ULimit - LLimit) + LLimit) 'Εισαγωγή του μοναδικού τυχαίου αριθμού στη συλλογή RandColl. Προσθήκη i, CStr (i) Στο Error GoTo 0' Looping μέχρι η συλλογή να έχει στοιχεία ίσα με numCount Loop Until RandColl.Count = Num Count ReDim varTemp (1 To NumCount) 'Εκχώρηση τιμής των στοιχείων της συλλογής σε varTemp array Για i = 1 στο NumCount varTemp (i) = RandColl (i) Next i UniqueRandomNumbers = varTemp Set RandColl = Τίποτα δεν διαγράφει varTemp Τέλος συνάρτησης Sub TestUniqueRandomNumbers () 'Δήλωση μεταβλητών Dim RandomNumberList As Variant Dim Counter As Long, LowerLimit As Long, UpperLimit As Long Dim Address As String' Λήψη των τιμών που εισάγει ο χρήστης Counter = Range ("C14"). Value LowerLimit = Range ("C12" ) .Value UpperLimit = Range ("C13"). Value Address = Range ("C15"). Value 'Calling custom function UniqueRandomNumbers RandomNumberList = UniqueRandomNumbers (Counter, LowerLimit, UpperLimit)' Επιλογή εύρους προορισμού (Διεύθυνση). Επιλογή 'Εκχώρηση η τιμή στο εύρος προορισμού (Επιλογή, Επιλογή. Μετατόπιση (Μετρητής - 1, 0)). Τιμή = _ Εφαρμογή. Μεταφορά (RandomNumberList) Τέλος υπο 

Αν σας άρεσε αυτό το blog, μοιραστείτε το με τους φίλους σας στο Facebook. Επίσης, μπορείτε να μας ακολουθήσετε στο Twitter και το Facebook.

Θα θέλαμε πολύ να σας ακούσουμε, ενημερώστε μας πώς μπορούμε να βελτιώσουμε το έργο μας και να το κάνουμε καλύτερο για εσάς. Γράψτε μας στον ιστότοπο email

Θα βοηθήσει στην ανάπτυξη του τόπου, μοιράζονται τη σελίδα με τους φίλους σας

wave wave wave wave wave