Génération de numéros ID uniques

[Cutbill1234]

Bonsoir le forum,

Mon besoin : j'ai une liste de 3000 produits et j'aimerais attribué à chacun de ces produits un numéro ID unique. Ce numéro d'ID ne devra jamais être modifié. Il est évident que je pourrais mettre sur la première ligne le chiffre 1 et incrémenter ma série, seulement j'ai la facheuse habitude de rentrer de nouveaux produits et de mettre les mêmes marques ensemble ; ce qui fait que je suis en permanence obligé d'insérer des lignes entre les lignes. Il devient dans ce cas impossible de mettre des ID manuellement. J'ai donc réussi avec quelques macros trouvés sur ce forum (et merci encore) à attribuer un ID aléatoire à mes articles, mais je ne comprends toujours pas comment, après l'insertion d'une nouvelle ligne, excel peut me générer un nouveau numéro unique pour cette cellule en tenant compte de ce qui a déjà été tiré dans cette colonne, car bien sur il ne faut pas de doublon.
Il m'arrive régulièrement de supprimer des produits, ce qui doit normalement libérer des ID.

En espérant avoir été assez clair dans mes explications.

D'avance merci pour votre aide si précieuse.

Cutbill

 

[Excel-lent]

Re : Génération de numéros ID uniques

Bonsoir Cutbill1234,

Pour savoir si ta macro gère la réaffectation des ID libérés, faudrait qu'on puisse voir ta macro! (merci de mettre ton fichier en pièce jointe, ou mettre un lien vers ta précédente discussion où figure le fichier).

Proposition de numérotation d'ID pour te simplifier la vie :
00000000

000 représentant tes marques, avec le cas présent tu es limité à 999 marques différentes

00000 représentant tes produits. Tu es donc dans le cas présent limité à 99.999 produits par marque.

A toi d'adapter la longueur de l'ID en fonction de tes besoins.

Avantage de cette méthode, lorsque tu trieras tes ID dans l'ordre croissant, cela regroupera AUTOMATIQUEMENT tous tes produits d'un même marque.

Dans l'attente de te lire.

 

[ROGER2327]

Re : Génération de numéros ID uniques

Bonsoir à tous,

Un coup d'œil là-dessus, peut-être ?
https://www.excel-downloads.com/threads/generer-des-codes-produits-internes.110668/​

Bonne nuit !
ROGER2327

 

[Cutbill1234]

Re : Génération de numéros ID uniques

Bonjour le forum,

En fait la macro que j'utilise est la suivante :

Sub Test()
GenereSerieAleatoireSansDoublons 30, Range("A1")
End Sub


Sub GenereSerieAleatoireSansDoublons(NbValeurs As Integer, Cell As Range)
Dim Tableau() As Integer, TabNumLignes() As Integer
Dim i As Integer, k As Integer

ReDim Tableau(NbValeurs)
ReDim TabNumLignes(NbValeurs)

For i = 1 To NbValeurs
TabNumLignes(i) = i
Tableau(i) = i
Next

'Initialise le générateur de nombres aléatoires
Randomize

For i = NbValeurs To 1 Step -1
k = Int((i * Rnd) + 1)
Cells(Cell.Row + i - 1, Cell.Column) = Tableau(TabNumLignes(k))
TabNumLignes(k) = TabNumLignes(i)
Next

End Sub

Excel-Lent, ta proposition est intéressante mais je pense qu'elle est un peu lourde à suivre au fil du temps car non automatisée.

Roger2327, ta macro est vraiment bien, mais moi j'ai juste besoin d'avoir un ID compris entre 0 et 4000 (pour prendre large) et ça serait parfait.

D'avance merci à vous.

Cutbill

 

[ROGER2327]

Re : Génération de numéros ID uniques

Bonsoir à tous.

À stephane5108 / Cutbill1234 : Suite à votre message privé, je joins un classeur. Dites-mois si cela vous convient. À plus tard...​

Bonne nuit !
ROGER2327

 

[suistrop]

Re : Génération de numéros ID uniques

salut,

Je voulais tester ma facon n ayant pas compris le code de ROGER2327 ...
donc ca marche pareil que roger sauf qu on click sur le bouton go.

Par contre la méthode de roger est beaucoup plus rapide , ca ne se voit pas pour 10 ou 100 code mais si tu veux lancer les 4000 je suis a l ouest , ca prend 5 seconde avec roger et plus d 1 minute avec moi .....

Donc roger si tu pouvais commenter ton code ca serait cool que je puisse utilisé cela eventuellement sur un pbl perso !!!

encore bravo roger.

 

[ROGER2327]

Re : Génération de numéros ID uniques

Bonsoir suistrop

Je réponds volontiers à votre demande. Puisque ce code vous intéresse, je vous communique sa version actuelle, plus rapide :
Taille d'échantillon (nb. lignes)______ancienne version______nouvelle version
___________32768_____________________________367 s_________________150 s
___________16384______________________________95 s__________________37 s
____________8192_______________________________ND___________________10 s
____________4096_______________________________ND____________________2,6 s
Les commentaires sont dans le dossier joint. Voici le code :

Option Explicit

[COLOR="SeaGreen"]'A placer dans un module de feuille.[/COLOR]
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) [COLOR="SeaGreen"]'pour A_COD[/COLOR]
Dim t As Single
    If Target.Cells(1, 1).Address = "$A$1" Then A_COD 1, Target.Cells(1, 1).Value: Cancel = True
End Sub

pour le module de feuille.

Option Explicit

[COLOR="SeaGreen"]'A placer dans un module standard[/COLOR]
Sub A_COD(ByVal c As Long, Optional p As String)
[COLOR="SeaGreen"]' 21 Nivôse CCXVII[/COLOR]
[COLOR="SeaGreen"]' ROGER2327 fecit.[/COLOR]
Dim i As Long, j As Long, n As String, cal As Long
Dim dat(), UBDat As Long
Dim pt()
    Application.ScreenUpdating = False
    cal = Application.Calculation
    Application.Calculation = xlCalculationManual
    If Len(p) = 0 Then [COLOR="SeaGreen"]' modèle par défaut LL[-]00[-]LL[/COLOR]
        pt = Array(8, Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), Array(0, "-"), _
            Array(10, "1234567890"), Array(10, "1234567890"), Array(0, "-"), Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), _
            Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
    Else
        ReDim pt(Len(p))
        pt(0) = 0
        j = 1
        i = 1
        For i = 1 To Len(p)
            n = Mid$(p, j, 1)
            Select Case n
                Case "": Exit For
                Case "{"
                    n = Mid$(p, j + 1, InStr(j, p, "}") - j - 1)
                    If IsNumeric(n) Then pt(i) = Array(-1, CInt(n)) Else pt(i) = Array(-1, Range(n & "1").Column)
                    j = j + Len(n) + 2
                    pt(0) = 1 + pt(0)
                Case "["
                    n = Mid$(p, j + 1, InStr(j, p, "]") - j - 1)
                    pt(i) = Array(0, n)
                    j = j + Len(n) + 2
                    pt(0) = 1 + pt(0)
                Case Else
                Select Case n
                    Case "0": pt(i) = Array(10, "1234567890"): pt(0) = 1 + pt(0): j = j + 1
                    Case "9": pt(i) = Array(9, "123456789"): pt(0) = 1 + pt(0): j = j + 1
                    Case "L": pt(i) = Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"): pt(0) = 1 + pt(0): j = j + 1
                    Case "M": pt(i) = Array(24, "ABCDEFGHJKLMNPQRSTUVWXYZ"): pt(0) = 1 + pt(0): j = j + 1
                    Case "C": pt(i) = Array(20, "BCDFGHJKLMNPQRSTVWXZ"): pt(0) = 1 + pt(0): j = j + 1
                    Case "V": pt(i) = Array(6, "AEIOUY"): pt(0) = 1 + pt(0): j = j + 1
                    Case "W": pt(i) = Array(4, "AEUY"): pt(0) = 1 + pt(0): j = j + 1
                    Case Else: pt(i) = Array(0, Mid$(p, j, 1)): pt(0) = 1 + pt(0): j = j + 1
                End Select
            End Select
        Next i
    End If
    ReDim Preserve pt(pt(0))
    dat = Cells(1, c).CurrentRegion.Value
    UBDat = UBound(dat, 1)
    For i = 2 To UBDat
        If IsEmpty(dat(i, c)) Then
            Do
                n = ""
                For j = 1 To pt(0)
                    Select Case pt(j)(0)
                    Case -1: n = n & dat(i, pt(j)(1))
                    Case 0: n = n & pt(j)(1)
                    Case Else: n = n & Mid$(pt(j)(1), Int(pt(j)(0) * Rnd() + 1), 1)
                    End Select
                Next j
                For j = 2 To UBDat
                    If n = dat(j, c) Then Exit For
                Next j
            Loop Until j > UBDat
            dat(i, c) = n
            Cells(i, c) = n
        End If
    Next i
    Application.Calculation = cal
    Application.ScreenUpdating = True
End Sub

pour le module standard.
Si des optimisations sont possibles, ne manquez pas de me les signaler. Merci d'avance.​

Bonne nuit à tous,
ROGER2327

 

[suistrop]

Re : Génération de numéros ID uniques

merci bien, mais je vois pas comment sont tiré aléatoirement les chiffres ici:
Case "0": pt(i) = Array(10, "1234567890"): pt(0) = 1 + pt(0): j = j + 1

 

[ROGER2327]

Re : Génération de numéros ID uniques

Re...

Mon cher suistrop, avez-vous pris le temps de lire les commentaires dont la rédaction m'a pris un certain temps, voire un temps certain ? J'en doute en lisant :

je vois pas comment sont tiré aléatoirement les chiffres ici:
Case "0": pt(i) = Array(10, "1234567890"): pt(0) = 1 + pt(0): j = j + 1
Hier 22h21

Heureusement que vous ne voyez pas ! Cette ligne est tiré de la première partie du code dans laquelle il s'agit non de faire le tirage, mais d'interpréter le modèle de référence. Je dis dans les commentaires :

La première partie du code interprète le modèle de référence en créant un tableau pt( ).

et, lignes 68-69 :

'...si 'n' est 0, il faudra tirer au hasard un des dix éléments de la chaîne "1234567890" : on place 'Array(10, "1234567890")' au rang 'i' dans 'pt'
Case "0": pt(i) = Array(10, "1234567890"): pt(0) = 1 + pt(0): j = j + 1

Il faudra tirer, pas je tire au hasard un des dix éléments de la chaîne... C'est du futur, et ce truc-là sert à dire qu'on ne fait pas maintenant mais qu'on attend sagement.
Ce tirage aura lieu dans la deuxième partie du code, à la ligne 97 :

           Case Else: n = n & Mid$(pt(j)(1), Int(pt(j)(0) * Rnd() + 1), 1)

ainsi commentée :

'dans les autres cas, tirer au hasard un caractère dans le deuxième élément
'et le placer dans la référence

J'espère que vous admettrez qu'à cet endroit, on tire au hasard l'un des caractères de la chaîne qu'on a chargé dans la première partie, exactement à l'endroit que vous signalez. Essayez d'exécuter la procédure pas à pas et vous verrez peut être ce qui se passe.
Vous avez dans le code un exemple tout fait de ce que fait la première partie :

[COLOR="Green"]'PREMIERE PARTIE[/COLOR]
    If Len(p) = 0 Then			[COLOR="Green"]' modèle par défaut LL[-]00[-]LL si le paramète 'p' est omis[/COLOR]
        pt = Array(8, Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), Array(0, "-"), _
            Array(10, "1234567890"), Array(10, "1234567890"), Array(0, "-"), Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), _
            Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))

Ce qui signifie que si on prend le modèle

LL[-]00[-]LL​

le tableau pt correspondant est

        pt = Array(8, Array(26, "ABCDEFGHIJKLMNOPQR[B][COLOR="Red"]S[/COLOR][/B]TUVWXYZ"), Array(26, "ABCDEFGHIJKLM[COLOR="Red"][B]N[/B][/COLOR]OPQRSTUVWXYZ"), Array(0, "[COLOR="Red"][B]-[/B][/COLOR]"), _
            Array(10, "12345[COLOR="Red"][B]6[/B][/COLOR]7890"), Array(10, "12[COLOR="Red"][B]3[/B][/COLOR]4567890"), Array(0, "[B][COLOR="Red"]-[/COLOR][/B]"), Array(26, "ABCDEFG[COLOR="Red"][B]H[/B][/COLOR]IJKLMNOPQRSTUVWXYZ"), _
            Array(26, "ABCDEFGHIJKLMNOPQRST[COLOR="Red"][B]U[/B][/COLOR]VWXYZ"))

1er élèment : 8 car suivent 8 sous tableaux.
Les deux premiers (Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ")) correspondent au deux L du modèle qui demandent le tirage de deux lettres.
Le troisième (Array(0, "-") correspond au premier tiret.
Le quatrième et le cinquième (Array(10, "1234567890")) correspondent aux deux 0 (zéro) du modèle qui demandent le tirage de deux chiffres quelconques.
Le sixième correspond au deuxième tiret, le septième et le huitième aux deux derniers L qui appellent encore le tirage de deux lettres.
Ce tableau sera utilisé dans la deuxième partie pour réaliser effectivement les tirages souhaités, et on obtiendra quelquechose comme :

SN-63-HU
AT-98-BK
WU-40-WB
YJ-68-BP​

etc.

Voilà, voilà...​

Bonne nuit !
ROGER2327

 

[suistrop]

Re : Génération de numéros ID uniques

Merci pour cette reponse complete, j avais bien compris le futur et je pensais que la prochaine ligne été considéré comme le futur, d'ou ma question.

En tout cas ce code est drolement astucieux je garde cette méthode dans ma tete et sur mon PC

 

[Cutbill1234]

Re : Génération de numéros ID uniques

Bonsoir le forum, ROGER2327, suistrop,

Merci Roger2327 d'avoir répondu à mon message privé et d'y avoir répondu aussi rapidement. Cette macro est parfaitement adaptée à mes besoins car elle m'a générée 3000 ID uniques en quelques secondes.

Merci à toi aussi suistrop pour ta particpation, mais il est vrai que pour 3000-4000 ID, cela prend un peu plus de temps que la méthode de Roger2327.

Encore un grand merci pour cette aide toujours aussi précieuse.

Cutbill1234