Atribution code unique sous certaines conditions

Bonjour a tous,

Je ne sais pas si ceci est possible en utilisant des simples fonction sur Excel, mais je vous fait savoir ce que je cherche quand meme..

Je voudrai générer un code unique et l afficher sur la colonne "C "commençant par 10 000 (puis incrémenter de +1) a chaque ligne qui respecte les conditions suivantes:

- les colonnes "J" et "K" doivent avoir du texte (n importe quel, suffit que la cellule ne soit pas vide )

ET

- le chiffre présent en colonne "L" soit supérieur a 1

Cela ressemblerai a ceci:

Attention, je dois pouvoir revenir sur une ligne au dessus plus tard, et faire de manière a ce que cette ligne respecte maintenant les conditions. Le numéro unique généré devra être toujours +1 par rapport au dernier existant. En aucun cas, les autres numéro doivent changer.

J espere me faire comprendre !!

Merci bcp

Bonjour,

Comme une formule Excel va aboutir à une référence circulaire puisque tu veux incrémenter les cellules dans lesquelles se trouvent la formule, je te propose une procédure événementielle. Ce code est à mettre dans le module de la feuille concernée :

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Maxi As Long

    If Target.Column <> 10 And Target.Column <> 11 Then Exit Sub

    If Cells(Target.Row, 10) <> "" And Cells(Target.Row, 11) <> "" Then

        Application.EnableEvents = False

        Maxi = Application.Max(Range("C:C"))
        If Maxi < 10000 Then Maxi = 99999

        Cells(Target.Row, 3).Value = Maxi + 1

        Application.EnableEvents = True

    End If

End Sub

Salut hrakitu, Theze,

quasi pareil, évidemment...

@Theze : j'ai beau te relire, il me semble que tu as oublié le critère de la colonne "L"...

Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.EnableEvents = False
'
If Not Intersect(Target, Union(Range("J:J"), Range("K:K"), Range("L:L"))) Is Nothing Then
    iRow = Target.Row
    If Cells(iRow, 3) = "" And Cells(iRow, 10) <> "" And Cells(iRow, 11) <> "" And Cells(iRow, 12) > 1 Then
        Cells(iRow, 3) = IIf(Application.Max(Range("C:C")) < 10000, 10000, Application.Max(Range("C:C")) + 1)
    End If
End If
'
Application.EnableEvents = True
'
End Sub

A+

Bonjour,

Hello curulis57, effectivement, je l'ai oublié ! Oups !!!

Comme ton code fais parfaitement ce qui est demandé, je ne vais pas poster de code corrigé

Vous etez énorme !! ça marche

Merci bcp a vous deux, Theze et curulis57 !!

curulis57 a écrit :

Salut hrakitu, Theze,

quasi pareil, évidemment...

@Theze : j'ai beau te relire, il me semble que tu as oublié le critère de la colonne "L"...

Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.EnableEvents = False
'
If Not Intersect(Target, Union(Range("J:J"), Range("K:K"), Range("L:L"))) Is Nothing Then
    iRow = Target.Row
    If Cells(iRow, 3) = "" And Cells(iRow, 10) <> "" And Cells(iRow, 11) <> "" And Cells(iRow, 12) > 1 Then
        Cells(iRow, 3) = IIf(Application.Max(Range("C:C")) < 10000, 10000, Application.Max(Range("C:C")) + 1)
    End If
End If
'
Application.EnableEvents = True
'
End Sub

A+

Re,

Du coup, je suis désolé, j'y ai pas pensé mais pour améliorer la chose il y a une autre conditions pour atribution du code unique:

- Le texte présent en colonne "G" ne peut pas se répéter. C'est a dire que si je rajoute une ligne qui respecte les 3conditions précédentes mais dont le texte en "G" est identique a une ligue qui possède déjà un numéro unique, je ne souhaite pas que un nouveau numéro soit créer !

Je vous remercie d avance pour l effort !

Salut hrakitu,

voici...

Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.EnableEvents = False
'
If Not Intersect(Target, Union(Range("J:J"), Range("K:K"), Range("L:L"))) Is Nothing Then
    iRow = Target.Row
    If Cells(iRow, 3) = "" And Cells(iRow, 10) <> "" And Cells(iRow, 11) <> "" And Cells(iRow, 12) > 1 Then
        iFlag = 0
        For x = 2 To Range("G" & Rows.Count).End(xlUp).Row
            If x <> Target.Row And Cells(x, 3) > 0 And Cells(x, 7) = Cells(Target.Row, 7) Then iFlag = 1
        Next
        If iFlag = 0 Then Cells(iRow, 3) = IIf(Application.Max(Range("C:C")) < 10000, 10000, Application.Max(Range("C:C")) + 1)
    End If
End If
'
Application.EnableEvents = True
'
End Sub

A+ pour une prochaine condition...

MERCI curulis57 !! Testé et validé

Je reviendrai très probablement vers vous.. peut etre pas pour d autres conditions mais toujours par rapport a ce petit projet

Je reviens plus tôt que prévue

Pas pour une nouvelles conditions mais pour modifier juste une chose:

Sur ce que curulis57 a proposé:

- je ne peux pas revenir sur une ligne où il manque uniquement la condition "texte unique en colonne C" et attribuer un code des que ce texte est introduit!

J ai d autres idees en tete mais je vais y reflexir un peu avant de revenir vers vous..

Merci!

Bonsoir hrakiyu,

exact, j'avais oublié, à mon tour, d'actualiser la première ligne suite à l'introduction de la dernière condition..

Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.EnableEvents = False
'
If Not Intersect(Target, Union(Range("G:G"), Range("J:L"))) Is Nothing Then
    iRow = Target.Row
    If Cells(iRow, 3) = 0 And Cells(iRow, 10) <> "" And Cells(iRow, 11) <> "" And Cells(iRow, 12) > 1 Then
        If Cells(iRow, 7) <> "" And WorksheetFunction.CountIf(Range("G:G"), Cells(iRow, 7)) = 1 Then _
            Cells(iRow, 3) = IIf(WorksheetFunction.Max(Range("C:C")) < 10000, 10000, Application.Max(Range("C:C")) + 1)
    End If
End If
'
Application.EnableEvents = True
'
End Sub

A+

curulis57, Suis vraiment désolé mais il y a encore un soucis.. je pense que tu as repris le mauvais code

"- Le texte présent en colonne "G" ne peut pas se répéter. C'est a dire que si je rajoute une ligne qui respecte les 3conditions précédentes mais dont le texte en "G" est identique a une ligne qui possède déjà un numéro unique, je ne souhaite pas que un nouveau numéro soit créer !"

Uniquement si la ligne possède un numéro unique. Et en ce moment, n’importe quelle ligne qui se répète en G n'a pas de numéro atribué !!

Re Merci !!!

On va y arriver!

Normalement, ici, ça doit couvrir les cas prévus!

Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.EnableEvents = False
'
If Not Intersect(Target, Union(Range("G:G"), Range("J:L"))) Is Nothing Then
    iRow = Target.Row
    If Val(Cells(iRow, 3)) = 0 And Cells(iRow, 10) <> "" And Cells(iRow, 11) <> "" And Cells(iRow, 12) > 1 Then
        iFlag = 0
        For x = 2 To Range("G" & Rows.Count).End(xlUp).Row
            If x <> iRow And Cells(x, 7) = Cells(iRow, 7) And Cells(x, 3) > 0 Then iFlag = 1
        Next
        If iFlag = 0 Then Cells(iRow, 3) = IIf(WorksheetFunction.Max(Range("C:C")) < 10000, 10000, Application.Max(Range("C:C")) + 1)
    End If
End If
'
Application.EnableEvents = True
'
End Sub

A+