Discussion :

[dris974]

Bonjour à tous

je reviens vers vous ce jour par je suis bloquer depuis 3 jour sur cette macro je suis vraiment perdu
je vous explique j'ai une colonne A(nommé test) ou je rentre une série de chiffre les 2 derniers sont une clé de vérification une colonne B (nommé verif ) une formule qui reprend les 12 premier caractère de la colonne A et une colonne C ((nommé résultat) quand je remplis par exemple la cellule "A1" la macro ecrit le resultat dans "C1". Une mise en forme qui mets la cellule a1 en rouge si la clé est incorrect
Ma macro fonctionne très bien pour faire cela. Mais j'aimerais rajouté 2 chose:
1) il peut m'arrivé de coller une liste de 10 série de chiffre la macro ne prend en compte que la cellule "A1" et du coup mets le résultat que dans "C1" les autre cellule ne sont pas vérifié
2) lorsque la clé que j'ai rentré est incorrect je doit l'effacer et comme la cellule change la macro fait le calcul et mets 0 dans le résultat du coup ma cellule reste rouge donc je voudrais que si la cellule "verif" vaut rien ("") j'aimerais effacer le contenue de la cellule "résultat"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("test")) Is Nothing Then
 
Dim sMatricule As String
Dim iSommePourDizaine As Integer
Dim iSommePourUnite As Integer
Dim iCompteur As Integer
Dim iCleDizaine As Integer
Dim iCléUnite As Integer
Dim iCalcul As Single
Dim iMultiplicateur As Integer
Dim iCleCTG As Integer
 
iMultiplicateur = 1
iCompteur = 0
 
        sMatricule = Range("verif")(Target.Row - 1).Value
 
iSommePourDizaine = 0
'Calcul somme pour la clé dizaine et unité
    Do Until sMatricule = ""
 
        If iCompteur <> 7 Then
            iSommePourDizaine = iSommePourDizaine + Right(sMatricule, 1)
            iSommePourUnite = iSommePourUnite + (Right(sMatricule, 1) * iMultiplicateur)
            iMultiplicateur = iMultiplicateur + 1
            iCompteur = iCompteur + 1
            sMatricule = Left(sMatricule, 12 - iCompteur)
        Else
            iSommePourDizaine = iSommePourDizaine + 1
            iSommePourUnite = iSommePourUnite + (1 * iMultiplicateur)
            iMultiplicateur = iMultiplicateur + 1
            iCompteur = iCompteur + 1
            sMatricule = Left(sMatricule, 12 - iCompteur)
        End If
    Loop
 
'calcul clé dizaine
iCalcul = iSommePourDizaine Mod 11
    If iCalcul < 10 Then iCleDizaine = iCalcul
    If iCalcul = 10 Then iCleDizaine = 0
 
iSommePourDizaine = 0
iCalcul = 0
'Calcul cle unité
iCalcul = iSommePourUnite Mod 11
    If iCalcul < 10 Then iCléUnite = iCalcul
    If iCalcul = 10 Then iCléUnite = 0
'concatenation cledizaine+cle unité
        Range("resultat")(Target.Row - 1) = iCleDizaine & iCléUnite
 
End If
 
End Sub

j'ai voulu mettre ce code après mon end if mais excel plante ne répond plus

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
 If Range("verif")(Target.Row - 1).Value = ""   'si la celule de la plage verif de la meme ligne que la cellule modifie vaut rien
    Range("resultat")(Target.Row - 1).clear     'effacer la celule de la plage resultat e la meme ligne que la cellule modifie
End If

si quelqu'un peut me remettre sur la voie ce serait géant je peut poster un fichier si pour vous se serait plus parlant
Merci d'avance

[pgz]

Bonjour.

Pour que ta correction ne déclenche pas de nouveau la procédure évènementielle, en début de procédure

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.EnableEvents = False

et en fin de procédure

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.EnableEvents = True

COrdialement,

PGZ

[mercatog]

Bonsoir

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iSommePourDizaine As Integer, iSommePourUnite As Integer, iCompteur As Integer, iMultiplicateur As Integer
Dim iCalcul As Byte
Dim bCle As Byte
Dim sMatricule As String
Dim c As Range
 
If Not Intersect(Target, Range("test")) Is Nothing Then
    For Each c In Intersect(Target, Range("test"))
        sMatricule = c.Offset(0, 1).Value
        If Len(sMatricule) >= 12 And c.Value <> "" Then
            'Initialisation
            iCompteur = 0: iMultiplicateur = 1
            iSommePourDizaine = 0: iSommePourUnite = 0
            'Calcul somme pour la clé dizaine et unité
            Do Until sMatricule = ""
                iSommePourDizaine = iSommePourDizaine + IIf(iCompteur <> 7, Right(sMatricule, 1), 1)
                iSommePourUnite = iSommePourUnite + (IIf(iCompteur <> 7, Right(sMatricule, 1), 1) * iMultiplicateur)
                iMultiplicateur = iMultiplicateur + 1
                iCompteur = iCompteur + 1
                sMatricule = Left(sMatricule, 12 - iCompteur)
            Loop
            'calcul clé dizaine
            iCalcul = iSommePourDizaine Mod 11
            bCle = IIf(iCalcul = 10, 0, iCalcul)
            'Calcul cle unité
            iCalcul = iSommePourUnite Mod 11
            bCle = bCle & IIf(iCalcul = 10, 0, iCalcul)
        End If
        Application.DisplayAlerts = False
        c.Offset(0, 2).Value = IIf(bCle = 0, "", bCle)
        Application.DisplayAlerts = True
    Next c
End If
End Sub

Edit: En compactant

[dris974]

je vous remercie tous les deux pour vos reponse

mercatog je vais travailler sur ton code car en faite je ne veut pas designer des colonne car si un jour je doit insérer une nouvelle colonne il faut que je modifie toute les macro
mais en tout cas c'a a l'air d’être sa mais il me laisse parfois des cellule vides dans la colonne résultat

mais encore un grand MERCI

[mercatog]

Pour passer par les plages nommés

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iSommePourDizaine As Integer, iSommePourUnite As Integer, iCompteur As Integer, iMultiplicateur As Integer
Dim iCalcul As Byte
Dim bCle As Byte
Dim sMatricule As String
Dim c As Range
 
If Not Intersect(Target, Range("test")) Is Nothing Then
    For Each c In Intersect(Target, Range("test"))
        sMatricule = Intersect(c.EntireRow, Range("Verif")).Value
        If Len(sMatricule) >= 12 And c.Value <> "" Then
            'Initialisation
            iCompteur = 0: iMultiplicateur = 1
            iSommePourDizaine = 0: iSommePourUnite = 0
            'Calcul somme pour la clé dizaine et unité
            Do Until sMatricule = ""
                iSommePourDizaine = iSommePourDizaine + IIf(iCompteur <> 7, Right(sMatricule, 1), 1)
                iSommePourUnite = iSommePourUnite + (IIf(iCompteur <> 7, Right(sMatricule, 1), 1) * iMultiplicateur)
                iMultiplicateur = iMultiplicateur + 1
                iCompteur = iCompteur + 1
                sMatricule = Left(sMatricule, 12 - iCompteur)
            Loop
            'calcul clé dizaine
            iCalcul = iSommePourDizaine Mod 11
            bCle = IIf(iCalcul = 10, 0, iCalcul)
            'Calcul cle unité
            iCalcul = iSommePourUnite Mod 11
            bCle = bCle & IIf(iCalcul = 10, 0, iCalcul)
        End If
        Application.DisplayAlerts = False
        Intersect(c.EntireRow, Range("Resultat")).Value = IIf(bCle = 0, "", bCle)
        Application.DisplayAlerts = True
    Next c
End If
End Sub

il me laisse parfois des cellule vides dans la colonne résultat

Au cas où la cellule de la colonne test est vide ou la longueur du contenu de la cellule de la colonne verif est inférieur à 12. Bon c'est ce que j'avais compris.

[dris974]

Merci mercatog j'ai compris pourquoi parfois il me laisse la case vide dans résultat c'est quand le vrai résultat vaut "00"

[dris974]

ca y est j'ai trouver
et encore un grand merci a tous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iSommePourDizaine As Integer, iSommePourUnite As Integer, iCompteur As Integer, iMultiplicateur As Integer
Dim iCalcul As Byte
Dim bCle As Byte
Dim sMatricule As String
Dim c As Range
 
If Not Intersect(Target, Range("test")) Is Nothing Then
    For Each c In Intersect(Target, Range("test"))
        If Intersect(c.EntireRow, Range("Verif")).Value = "" Then
            Application.EnableEvents = False
            Intersect(c.EntireRow, Range("Resultat")).ClearContents
            Application.EnableEvents = True
            GoTo suivant
        End If
 
        sMatricule = Intersect(c.EntireRow, Range("Verif")).Value
        If Len(sMatricule) >= 12 And c.Value <> "" Then
            'Initialisation
            iCompteur = 0: iMultiplicateur = 1
            iSommePourDizaine = 0: iSommePourUnite = 0
            'Calcul somme pour la clé dizaine et unité
            Do Until sMatricule = ""
                iSommePourDizaine = iSommePourDizaine + IIf(iCompteur <> 7, Right(sMatricule, 1), 1)
                iSommePourUnite = iSommePourUnite + (IIf(iCompteur <> 7, Right(sMatricule, 1), 1) * iMultiplicateur)
                iMultiplicateur = iMultiplicateur + 1
                iCompteur = iCompteur + 1
                sMatricule = Left(sMatricule, 12 - iCompteur)
            Loop
            'calcul clé dizaine
            iCalcul = iSommePourDizaine Mod 11
            bCle = IIf(iCalcul = 10, 0, iCalcul)
            'Calcul cle unité
            iCalcul = iSommePourUnite Mod 11
            bCle = bCle & IIf(iCalcul = 10, 0, iCalcul)
        End If
        Application.DisplayAlerts = False
        Intersect(c.EntireRow, Range("Resultat")).Value = IIf(bCle = 0, "00", bCle)
        Application.DisplayAlerts = True
suivant:
    Next c
End If
End Sub