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 |
Partager