petit soucis avec un Private Sub Worksheet_Change(ByVal Target As Range)

Version imprimable

Bonjour à tous

je reviens vers vous ce jour par je suis bloquer depuis 3 jour sur cette macro :cry: 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:

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:

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

25/03/2011, 20h39
pgz

Bonjour.

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

Code:

Application.EnableEvents = False

et en fin de procédure

Code:

Application.EnableEvents = True

COrdialement,

PGZ

Bonsoir

Code:

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

25/03/2011, 23h54
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

Pour passer par les plages nommés

Code:

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

Citation:

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.

26/03/2011, 19h50
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"

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

Code:

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