Forum - Γενικά Δημιουργία τυχαίων και μοναδικών 4ψήφιων αριθμών

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - [Γενικά] Δημιουργία τυχαίων και μοναδικών 4ψήφιων αριθμών (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/3672-dimioyrgia-tyxaion-kai-monadikon-4psifion-arithmon.html)

Δημιουργία τυχαίων και μοναδικών 4ψήφιων αριθμών

Καλημέρα!!

Έχω μια λίστα με μερικές εκατοντάδες ονόματα.
Το ζητούμενο είναι το εξής:
πρέπει δίπλα σε κάθε ονοματεπώνυμο να υπάρχει (ενδεικτικά,στη Στήλη D του επισυναπτόμενου αρχείου) έναν τυχαίος αλλά μοναδικός 4ψήφιος αριθμός έτσι ώστε στον κάθε άνθρωπο να αντιστοιχεί ο ατομικός του μοναδικός αριθμός.
Πώς μπορεί να γίνει χωρίς μακροεντολές;

Ευχαριστώ

Καλημέρα

Διονύση, δες μια πρόταση στο συνημμένο.

Φιλικά/Γιώργος

Μια άλλη ιδέα θα ήταν η εξής:
Στο κελί e4

Κώδικας:

=RANDBETWEEN(1000;9999)

Στο κελί f4 τύπος πίνακα (Ctrl +Shift + Enter)

Κώδικας:

=LARGE(ROW($1000:$9999)*NOT(COUNTIF($E$4:E4;ROW($1000:$9999)));RANDBETWEEN(1;(9999+2-1000)-ROW(D4)))

Τραβάμε κάτω όσο χρειάζεται.
Πλεονέκτημα:
Δεν έχουμε αριθμούς μόνο από την πρώτη χιλιάδα (1001, 1005, 1125 ... κλπ)
Αντιγράφουμε τις τιμές μόνο από την περιοχή f4: fx στην περιοχή d4:dx

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

Πρόταση:
VBA

Κώδικας:

Sub DoRandomValues()

    Dim FillRange As Range, c As Range

    Set FillRange = Range("d4:d17")

    For Each c In FillRange

        Do

            c.Value = Int((9999 - 1000 + 1) * Rnd + 1000)

        Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2

    Next

End Sub

Ο κώδικας αποδίδει τυχαίους 4ψήφιους αλλά:

Κώδικας:

'Προσθέτει γραμμή σε πίνακα

'Προσθέτει ID που αυξάνει + 1 με κάθε νέα γραμμή

Sub AddRow_Tbl()

    Dim c As Range

    Application.ScreenUpdating = False

    Sheet1.Range("_").ListObject.ListRows.Add (1)

    Range("SetStartID").Value = Range("SetStartID").Value  + 1

    For Each c In Range("Column_With_ID")

        If c.Value = vbNullString Then

            c.Value = "ID_" & " " & Range("SetStartID").Value

        End If

    Next

End Sub

αυτός αποδίδει σε πίνακα μοναδικό ID μορφής ID_2568
αυξανόμενο κατά 1 σε κάθε νέα εγγραφή.
Πλεονέκτημα:
Ποτέ δεν θα υπάρξει επανάληψη ενός αριθμού ID (όπως στην Access)

Sheet1 = το κωδικό όνομα φύλλου
Range("_") = πρώτο κελί αριστερά κάτω από κεφαλίδα
Range("SetStartID") = ένα κελί με τον αριθμό εκκίνησης ID
Range("Column_With_ID") = ονομασία της στήλης πίνακα με τα ID
Add (1) = η θέση εισαγωγής νέας γραμμής (πρώτη)

Γιώργο και Σπύρο ευχαριστώ για τις άμεσες και εμπεριστατωμένες απαντήσεις-προτάσεις σας.
Με μια πρόχειρη ματιά είδα ότι με καλύπτουν γι'αυτό που ζητάω. Θα τις μελετήσω και θα καταλήξω σε μία από αυτές.
:thanks: