VBA Gestion d'une sélection multiple

Version imprimable

1 pièce(s) jointe(s)

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 :

Pièce jointe 483529

Avec ce code (ne riez pas je suis débutant en VBA) j'y arrive :
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 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

14/06/2019, 17h24
patricktoulon

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

fait une boucle sur target.count
Code:

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

Merci beaucoup Patrick,

J'ai rajouté la boucle

Code:

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:

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:

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

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:

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

18/06/2019, 10h35
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