Discussion :

[Alex BI]

Bonjour le forum,

Je fais suite à la conversation "VBA problème avec le Worksheet change" sur un projet d'outil pour faire des devis et gérer des prix.

Donc sur la base du prix existant en colonne F je veux :

-Soit calculer mon taux de discount en L si un nouveau prix est saisi en K
-Soit calculer mon nouveau prix en K si un discount est saisi en L

Exemple de mon tableau avec des data bidonnées :



Avec ce code (ne riez pas je suis débutant en VBA) j'y arrive :

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim AD As String
AD = Target.Address
TG = Target.Column
 
 
            Select Case TG
                'L'utilsateur saisi un discount
                Case Is = 12
                Application.EnableEvents = False
                    If IsEmpty(Range(AD).Value) = True Then 'Si il efface la valeur
                    Range(AD).Offset(0, -1).FormulaR1C1 = ""
                    Else
                    Range(AD).Offset(0, -1).FormulaR1C1 = "=RC[-5]*(1-RC[1])"
                    End If
                Application.EnableEvents = True
 
                'L'utilsateur saisi un nouveau prix
                Case Is = 11
                Application.EnableEvents = False
 
                    If IsEmpty(Range(AD).Value) = True Then 'Si il efface la valeur
                    Range(AD).Offset(0, 1).FormulaR1C1 = ""
                    Else
                    Range(AD).Offset(0, 1).FormulaR1C1 = "=(RC[-6]-RC[-1])/RC[-6]"
                    End If
                Application.EnableEvents = True
 
            End Select
 
End Sub

Mais le problème c'est que si l'utilisateur sélectionne plusieurs cellules, par exemple pour effacer des saisies précédente, ça ne marche plus. Pareil si l'utilisateur copie/colle une liste de prix existant en ligne K.

J'ai compris que ça ne marche pas à cause du fait que ce soit des plages de cellules qui sont modifiées au lieu de cellule. j'ai bricolé des trucs pour test mais rien ne marche.

Auriez vous une piste ou une idée ?

Merci d'avance

[patricktoulon]

re
ben en fait tes pas loin
au lieu de vouloir formuler ton target

fait une boucle sur target.count

Code :

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

1
2
3
4
5
6
7
8
9
10
11
set case target.column
case 11
for each cel in target.count 
'calcul 
next 
case 12
for each cel in target.count 
'calcul 
next 
 
end select

si il y en a qu'une ben y en a qu'une
ajoute quand meme un control sur le target.columns.count avant le select case tu peux avoir plussieur lignes mais qu'une colonne !!!!!!!!!!!!!!!!!!!
voir même interdire la modification K:L en même temps au cas ou il y aurais une sub ou fonction qui viendrait foutre le boxon

[Alex BI]

Merci beaucoup Patrick,

J'ai rajouté la boucle

Code :

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

For Each cel In Target.Count

mais ça me génère une erreur de compilation "For Each ne peut itérer que sur un objet Collection ou un tableau"

En fait Target.count ne donne que le nombre de cellules qui sont modifiées (1,2,4,65) donc il n'arrive pas à faire for each.

J'ai modifié la solution avec Target à la place de Target.count et c'est mieux.

Par contre j'ai l'impression que ce que le code ne comprends pas c'est quand l'utilisateur efface plusieurs new price par exemple. Donc si je selctionne des new prices et que je "suppr", la valeur de

Code :

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

IsEmpty(Range(AD).Value)

est "faux" alors que si je sélectionne une seule valeur et que je "suppr" c'est = Vrai.

Comment je pourrais faire pour que le code comprenne que je sélectionne plusieurs cellules et que je les "suppr" ?

Code complet :

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim AD As String
AD = Target.Address
TG = Target.Column
 
 
 
            Select Case TG
                Case Is = 12
 
                Application.EnableEvents = False
                For Each cel In Target
 
                    If IsEmpty(Range(AD).Value) = True Then
                    Range(AD).Offset(0, -1).FormulaR1C1 = ""
                    Else
                    Range(AD).Offset(0, -1).FormulaR1C1 = "=RC[-5]*(1-RC[1])"
                    End If
 
                Next
                Application.EnableEvents = True
 
                Case Is = 11
 
                Application.EnableEvents = False
                For Each cel In Target
 
                    If IsEmpty(Range(AD).Value) = True Then
                    Range(AD).Offset(0, 1).FormulaR1C1 = ""
                    Else
                    Range(AD).Offset(0, 1).FormulaR1C1 = "=(RC[-6]-RC[-1])/RC[-6]"
                    End If
 
                Next
                Application.EnableEvents = True
 
            End Select
 
End Sub

Merci

[patricktoulon]

salut

normalement celle ci met les formules ou pas sur toute les ligne de la target

1 ligne si target est une seule cellules ou toutes les lignes si target est une plage de cellule
c'est tout totomatic'

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
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cel As Range, TG As Long
    TG = Target.Column
 
    Application.EnableEvents = False
    Select Case TG
    Case Is = 12
        For Each cel In Target.Cells
            If IsEmpty(cel.Value) = True Then
                cel.Offset(0, -1).FormulaR1C1 = ""
            Else
                cel.Offset(0, -1).FormulaR1C1 = "=RC[-5]*(1-RC[1])"
            End If
        Next
    Case Is = 11
        For Each cel In Target.Cells
            If IsEmpty(cel.Value) = True Then
                cel.Offset(0, 1).FormulaR1C1 = ""
            Else
                cel.Offset(0, 1).FormulaR1C1 = "=(RC[-6]-RC[-1])/RC[-6]"
            End If
        Next
    End Select
    Application.EnableEvents = True
End Sub

[Alex BI]

Merci Patrick c'est génial,

Je vais me servir de cette méthode pour d'autres problèmes que je rencontre dans ce projet.

Bonne journée