Εμφάνιση ενός μόνο μηνύματος
  #1  
Παλιά 22-01-13, 09:00
Το avatar του χρήστη Tasos
Tasos Ο χρήστης Tasos δεν είναι συνδεδεμένος
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.035
Προεπιλογή Αυτόματη καταχώρηση τυχαίων αριθμών σε μια στήλη

Στο παράδειγμα αυτό, με την μακροεντολή (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
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών

Τελευταία επεξεργασία από το χρήστη Tasos : 24-01-13 στις 01:53.
Απάντηση με παράθεση