fonction modifier plage de cellule

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

alors mon problème sous vba est le suivant:

j'ai un traitement à faire sur un nombre de cellule: plus concretement: supposant qu'on a 5 cellule à coté l'un de l'autre, si on a une cellule negative et le reste des cellules positives alors on met la cellule negative à zero et on réparti la valeur negative sur les cellule positives

Exemple

5 10 -6 3 0 => 3 8 0 1 0

Ce n'était pas difficil je l'ai déja fait! le probleme que j'ai c'est de le mettre sous forme de fonction et de l'appliquer à tous les plages de cellules que je veux!

Je ne sais pas si ça existe sous vba mais je suis resté bloqué la dessus pendant 2 jours

voilà le code auquel je suis arrivé
Code:

1 2 3 4 5 6 Private Sub CommandButton1_Click() modifier_plage(("A10"), ("E10")) 'c'est à dire le range A10:E10 modifier_plage(("G10"), ("N10")) modifier_plage(("S10"), ("V10")) modifier_plage(("A5"), ("E5")) End Sub
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 Public Function modifier_plage(ByRef Y As Range, ByRef Z As Range) Dim Plage_calcul As Range Set Plage_calcul = Range(Y.Address & ":" & Z.Address) Dim Plage As Range, Cellule As Range Dim Position As Integer Dim valeurneg As Integer Dim nbpos As Integer nbpos = 0 valeurneg = 0 For Each Cellule In Plage_calcul If Cellule.Value < 0 Then valeurneg = -Cellule.Value ' And Cellule.Value = 0 If Cellule.Value > 0 Then nbpos = nbpos + 1 Next Cellule If valeurneg <> 0 Then For Each Cellule In Plage If Cellule.Value > 0 Then Cellule.Value = Cellule.Value - valeurneg / nbpos If Cellule.Value < 0 Then Cellule.Value = 0 Next Cellule End If End Function
Pour plus d'explication vous trouverez en pièce jointe mon fichier excel

Je vous remercie d'avance pour votre aide

emplacement code VBA

bonjour,

Etant débutant sous VBA je viens vers vous pour un problème lors du codage. J'ai un soucis concernant l'emplacement de l'écriture de mon code VBA.

la finalité de mon programme est que juste en appuyant sur un boutton se trouvant sur une feuil, on arrive à appliquer une fonction sur une plage de donné se trouvant sur des worksheets différents. Je vous donne mon code:

ce code se trouve sur la feuil1:

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
Option Explicit
Private Sub CommandButton1_Click()
Dim param1 As Range, param2 As Range, param3 As Range, param4 As Range
Dim param5 As Range, param6 As Range, param7 As Range, param8 As Range
 
    With Worksheets("Feuil1")
        Set param1 = .Range("A10")
        Set param2 = .Range("E10")
        Set param3 = .Range("A22")
        Set param4 = .Range("E22")
        Set param5 = .Range("S10")
        Set param6 = .Range("V10")
        Set param7 = .Range("A11")
        Set param8 = .Range("E11")
 
    End With
 
    modifier_plage param1, param2
    modifier_plage param3, param4
    modifier_plage param5, param6
    modifier_plage param7, param8
 
    Set param1 = Nothing
    Set param2 = Nothing
    Set param3 = Nothing
    Set param4 = Nothing
    Set param5 = Nothing
    Set param6 = Nothing
    Set param7 = Nothing
    Set param8 = Nothing
 
 
 
 
       With Worksheets("Feuil3")
        Set param1 = .Range("A10")
        Set param2 = .Range("E10")
        Set param3 = .Range("A22")
        Set param4 = .Range("E22")
        Set param5 = .Range("S10")
        Set param6 = .Range("V10")
        Set param7 = .Range("A11")
        Set param8 = .Range("E11")
 
    End With
 
    modifier_plage param1, param2
    modifier_plage param3, param4
    modifier_plage param5, param6
    modifier_plage param7, param8
 
    Set param1 = Nothing
    Set param2 = Nothing
    Set param3 = Nothing
    Set param4 = Nothing
    Set param5 = Nothing
    Set param6 = Nothing
    Set param7 = Nothing
    Set param8 = Nothing
 
 
 
 
 
End Sub
 
 
Public Function modifier_plage(ByRef Y As Range, ByRef Z As Range)
Dim Plage_calcul As Range
Set Plage_calcul = Range(Y.Address & ":" & Z.Address)
Dim Plage As Range, Cellule As Range
Dim Position As Integer
Dim valeurneg As Integer
Dim nbpos As Integer
    nbpos = 0
    valeurneg = 0
    For Each Cellule In Plage_calcul
        If Cellule.Value < 0 Then valeurneg = -Cellule.Value
        ' And Cellule.Value = 0
        If Cellule.Value > 0 Then nbpos = nbpos + 1
    Next Cellule
    If valeurneg <> 0 Then
        For Each Cellule In Plage_calcul
            If Cellule.Value > 0 Then Cellule.Value = Cellule.Value - valeurneg / nbpos
            If Cellule.Value < 0 Then Cellule.Value = 0
        Next Cellule
    End If
End Function

ce code se trouve sur module1

Code:

1
2
3
4
 
Sub macro1()
 
End Sub

J'arrive à appliquer la fonction modifier_plage sur feuil1 mais pas sur feuil3
Est ce que vous aurez une idée par rapport aux modifications à effectuer???

Je vous remercie d'avance

14/05/2012, 19h11
nchal

Bonjour,

Je dirais de mettre tout le code dans un module.

Bonsoir,

Un exemple de code qui répartie les valeurs négative dans une plage :

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
55
56
57
58
59
60
61
 
Private Sub CommandButton1_Click()
    modifier_plage ("A10:E10")
    modifier_plage ("A22:E22")
End Sub
 
Public Function modifier_plage(Plage As String)
   Dim c As Range
   Dim Plage_calcul As Range
   Dim valeurneg As Integer
   Dim nbVal As Integer
 
    Set Plage_calcul = Range(Plage)
   valeurneg = 0
   nbValNeg = 0
 
   'retrouve les valeurs négatives
   For Each c In Plage_calcul
       If c.Value <= 0 Then
            valeurneg = valeurneg - c.Value
            c.Value = 0
            nbValNeg = nbValNeg + 1
        End If
   Next c
 
    If nbValNeg > 0 Then
        Dim reste As Double
        reste = valeurneg / (Plage_calcul.Count - nbValNeg)
 
        Dim nbValNegSave As Integer
        nbValNegSave = 0
 
        'cherche des valeurs sur lesquelles on ne peut pas répartir la valeur négative entièrement
        Do While nbValNegSave <> nbValNeg
            nbValNegSave = nbValNeg
            For Each c In Plage_calcul
                If c.Value < reste And c.Value > 0 Then
                     valeurneg = valeurneg - c.Value
                     c.Value = 0
                     nbValNeg = nbValNeg + 1
                 End If
            Next c
 
            If nbValNeg = Plage_calcul.Count Then
                Call MsgBox("Impossible de répartir les valeurs négatives", vbExclamation + vbOKOnly, "Error")
                Exit Do
            Else
                reste = valeurneg / (Plage_calcul.Count - nbValNeg)
            End If
        Loop
 
        ' réparti les valeurs négatives
        For Each c In Plage_calcul
            If c.Value > 0 Then
                 c.Value = c.Value - reste
             End If
        Next c
 
    End If
 
End Function