VBA, gestion diviser par 0 sur plusieurs formules

Version imprimable

Bonjour
Je ne parviens pas pas gérer un code qui me permette de gérer la division par 0 d'une série de formule, certaines contiennent des données à diviser, d'autre non. Je souhaiterai que le code permettent le calcul des cellules valorisée et passe celle avec des valeurs zéro. Je ne parviens à faire que du tout ou rien.
Le code: If InStr(1, Sheets("Fiche").Name, "Rdt_") <> 0 Then permet à l'ensemble de code de ne pas planter, mais aucun calcul ne se réalise. Est il possible de mettre une ligne qui gére pour l'ensemble du bloc de calcul, ou est il nécessaire de le recopier à chaque ligne?

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
End With
End Sub


Function TrouveType(V)
TrouveType = V
If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 And InStr(TrouveType, ":") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd hh:mm"): Exit Function
If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd"): Exit Function
If IsNumeric(Replace(TrouveType, ".", ",")) = True Then TrouveType = Replace(TrouveType, ",", "."): Exit Function
End Function

 Private Sub CmdModifier_Click()
     Dim Ctrl As Control
     Dim Colonne As Integer
     Dim Ligne As Long
     Dim I As Byte
     
             If Me.CboDate.ListIndex = -1 Then Exit Sub
             Ligne = Me.CboDate.ListIndex + 4
             With Sheets("Data_Système")
                 For Each Ctrl In Me.Controls
                     Colonne = Val(Ctrl.Tag)
                     If Colonne > 0 Then
                           .Cells(Ligne, Colonne) = TrouveType(Ctrl)
                         End If
                              Next Ctrl
                      If InStr(1, Sheets("Fiche").Name, "Rdt_") <> 0 Then
        .Cells(Ligne, 61) = TrouveType(Sheets("Fiche").Range("coût_Ha_C1") / Sheets("Fiche").Range("Rdt_C1"))
        .Cells(Ligne, 62) = TrouveType(Sheets("Fiche").Range("coût_Ha_C2") / Sheets("Fiche").Range("Rdt_C2"))
        .Cells(Ligne, 63) = TrouveType(Sheets("Fiche").Range("coût_Ha_C3") / Sheets("Fiche").Range("Rdt_C3"))
        .Cells(Ligne, 64) = TrouveType(Sheets("Fiche").Range("coût_Ha_C4") / Sheets("Fiche").Range("Rdt_C4"))
        .Cells(Ligne, 65) = TrouveType(Sheets("Fiche").Range("coût_Ha_C5") / Sheets("Fiche").Range("Rdt_C5"))
        .Cells(Ligne, 66) = TrouveType(Sheets("Fiche").Range("coût_Ha_C6") / Sheets("Fiche").Range("Rdt_C6"))
        .Cells(Ligne, 67) = TrouveType(Sheets("Fiche").Range("coût_Ha_C7") / Sheets("Fiche").Range("Rdt_C7"))
        .Cells(Ligne, 68) = TrouveType(Sheets("Fiche").Range("coût_Ha_C8") / Sheets("Fiche").Range("Rdt_C8"))
        .Cells(Ligne, 69) = TrouveType(Sheets("Fiche").Range("coût_Ha_C9") / Sheets("Fiche").Range("Rdt_C9"))
        .Cells(Ligne, 70) = TrouveType(Sheets("Fiche").Range("coût_Ha_C10") / Sheets("Fiche").Range("Rdt_C10"))
                     
                     End If
                     
             End With
Me.Hide
        
        End Sub


Private Sub CmdAnnuler_Click()
Me.Hide
End Sub

Cordialement
Joël

02/11/2014, 08h18
SfJ5Rpw8

Citation:

Envoyé par joel50

...
Le code: If InStr(1, Sheets("Fiche").Name, "Rdt_") <> 0 Then permet à l'ensemble de code de ne pas plante...

Bonjour,

tu devrais jeter un oeil sur l'aide en ligne de la fonction InStr pour comprendre ta condition... qui est toujours "FAUSSE"... Instr renvoi la poisition d'une chaine dans une autre, Sheets("Fiche").Name renvoi "Fiche" ..et donc instr renvoi la positon de "Rdt" dans "Fiche" soit 0 car pas de "Rdt" dans "Fiche" ...

cela équivaut à :

Code:

if 0 <> 0 then

et le code qui suit ne risque évidement pas de "planter" car il n'est jamais exécuté !

tu dois effectuer ton test pour chacune de tes divisions..

Bonjour bbil et merci, bonjour à tous

Effectivement c'est pas ce que je voulais faire.
J'espérais pouvoir mettre une condition au début de ma série de calcul qui puisse s'appliquer à chacune des formules individuellement afin d'éviter le risque d'erreur en recopie et qui soit réutilisable et facilement adaptable à mes autres formulaires et calculs.
Si quelqu'un a une solution globale, je suis preneur, j'ai une dizaine de formulaire à modifier.

Si ce n'est pas possible, je l'ai copiée pour chaque ligne, pour le division par zéro, c'est ok, mais, mon code bloque sur les cellules vides, et je ne parviens pas à le faire fonctionner avec les 2 conditions.
Ci-dessous, code qui bloque avec 2 conditions (mal écrites forcément)

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
89
90
91
92
93
94
95
 
Option Explicit
Dim Ligne As Long
 
 
Private Sub UserForm_Initialize()
Dim j As Long
 
  With Sheets("Data_Système")
    For j = 4 To .Range("A" & Rows.Count).End(xlUp).Row
      Me.CboDate.AddItem .Range("A" & j)
    Next j
  End With
    CboDate.Value = Format(CboDate.Value, "dd/mm/yy")
    CboDate.Value = Sheets("Fiche").Range("Date_Visite")
    Me.CboDate.Enabled = False
 
 
   End Sub
 
Private Sub CboDate_Change()
Dim Ctrl As Control
Dim Colonne As Integer
 
  If Me.CboDate.ListIndex = -1 Then Exit Sub
  With Sheets("Data_Système")
    Ligne = Me.CboDate.ListIndex + 4
    For Each Ctrl In Me.Controls
Colonne = CInt("0" & Ctrl.Tag)
      If Colonne > 0 Then Ctrl = .Cells(Ligne, Colonne)
    Next Ctrl
  End With
End Sub
 
 
Function TrouveType(V)
TrouveType = V
If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 And InStr(TrouveType, ":") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd hh:mm"): Exit Function
If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd"): Exit Function
If IsNumeric(Replace(TrouveType, ".", ",")) = True Then TrouveType = Replace(TrouveType, ",", "."): Exit Function
End Function
 
Private Sub CmdModifier_Click()
  Dim Ctrl As Control
  Dim Colonne As Integer
  Dim Ligne As Long
 
     If Me.CboDate.ListIndex = -1 Then Exit Sub
      Ligne = Me.CboDate.ListIndex + 4
        With Sheets("Data_Système")
           For Each Ctrl In Me.Controls
             Colonne = Val(Ctrl.Tag)
              If Colonne > 0 Then
                .Cells(Ligne, Colonne) = TrouveType(Ctrl)
              End If
           Next Ctrl
              If Sheets("Fiche").Range("Rdt_C1").Value <> 0 And Sheets("Fiche").Range("Rdt_C1").Value <> "" Then
                .Cells(Ligne, 61) = Sheets("Fiche").Range("coût_Ha_C1") / Sheets("Fiche").Range("Rdt_C1")
              End If
              If Sheets("Fiche").Range("Rdt_C2").Value <> 0 And Sheets("Fiche").Range("Rdt_C2").Value <> "" Then
                .Cells(Ligne, 62) = Sheets("Fiche").Range("coût_Ha_C2") / Sheets("Fiche").Range("Rdt_C2")
              End If
              If Sheets("Fiche").Range("Rdt_C3").Value <> 0 And Sheets("Fiche").Range("Rdt_C3").Value <> "" Then
                .Cells(Ligne, 63) = Sheets("Fiche").Range("coût_Ha_C3") / Sheets("Fiche").Range("Rdt_C3")
              End If
              If Sheets("Fiche").Range("Rdt_C4").Value <> 0 And Sheets("Fiche").Range("Rdt_C4").Value <> "" Then
                .Cells(Ligne, 64) = Sheets("Fiche").Range("coût_Ha_C4") / Sheets("Fiche").Range("Rdt_C4")
              End If
              If Sheets("Fiche").Range("Rdt_C5").Value <> 0 And Sheets("Fiche").Range("Rdt_C5").Value <> "" Then
                .Cells(Ligne, 65) = Sheets("Fiche").Range("coût_Ha_C5") / Sheets("Fiche").Range("Rdt_C5")
              End If
              If Sheets("Fiche").Range("Rdt_C6").Value <> 0 And Sheets("Fiche").Range("Rdt_C6").Value <> "" Then
                .Cells(Ligne, 66) = Sheets("Fiche").Range("coût_Ha_C6") / Sheets("Fiche").Range("Rdt_C6")
              End If
              If Sheets("Fiche").Range("Rdt_C7").Value <> 0 And Sheets("Fiche").Range("Rdt_C7").Value <> "" Then
                .Cells(Ligne, 67) = Sheets("Fiche").Range("coût_Ha_C7") / Sheets("Fiche").Range("Rdt_C7")
              End If
              If Sheets("Fiche").Range("Rdt_C8").Value <> 0 And Sheets("Fiche").Range("Rdt_C8").Value <> "" Then
                .Cells(Ligne, 68) = Sheets("Fiche").Range("coût_Ha_C8") / Sheets("Fiche").Range("Rdt_C8")
              End If
              If Sheets("Fiche").Range("Rdt_C9").Value <> 0 And Sheets("Fiche").Range("Rdt_C9").Value <> "" Then
                .Cells(Ligne, 69) = Sheets("Fiche").Range("coût_Ha_C9") / Sheets("Fiche").Range("Rdt_C9")
              End If
              If Sheets("Fiche").Range("Rdt_C10").Value <> 0 And Sheets("Fiche").Range("Rdt_C10").Value <> "" Then
                .Cells(Ligne, 70) = Sheets("Fiche").Range("coût_Ha_C10") / Sheets("Fiche").Range("Rdt_C10")
              End If
 
        End With
Unload Me
End Sub
 
 
Private Sub CmdAnnuler_Click()
Me.Hide
End Sub

Joël

Bonjour,
je ne voie pas les 10 formule

Code:

1
2
3
4
5
6
 
for x = 1 to 10
 If cdbl("0" & trim("" & Sheets("Fiche").Range("Rdt_C" & x).Value ))<> 0 Then
                .Cells(Ligne, 60 + x) = Sheets("Fiche").Range("coût_Ha_C" & x) / Sheets("Fiche").Range("Rdt_C" & x)
              End If
next

02/11/2014, 14h52
joel50

1 pièce(s) jointe(s)

Bonjour

Je re redige mon massage pour être un peu plus clair.
à la première mise en place du code , il me semblait qu'il fonctionnai comme je souhaitais.
En réalité, la condition permet à la commande de ne pas planter quand les cellules "divisante" sont zéro ou vide, mais ne recalcule pas les formules dans ces conditions, ce qui génère des erreur sur les tableurs suivant.

En pratique quand on exécute un première fois le formulaire modifier avec des valeur chiffrées, pas de souci, si on relance une seconde fois le formulaire avec des valeurs zéro, les calculs ne se font plus, les résultats sont faux.

Il faudrait que la commande rectifie systématiquement le calcul, si les valeur "divisante" sont vide le résultat doit être zéro.

Joël

Ci dessous, le code qui me créer la difficulté.

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
 
Option Explicit
Dim Ligne As Long
 
Private Sub UserForm_Initialize()
'CboDate = Date_Visite
Dim J As Long
 
  With Sheets("Données")
    For J = 4 To .Range("A" & Rows.Count).End(xlUp).Row
      Me.CboDate.AddItem .Range("A" & J)
    Next J
  End With
 
CboDate.Value = Format(CboDate.Value, "dd/mm/yy")
 
CboDate.Value = Sheets("Calcul").Range("LaDate")
    Me.CboDate.Enabled = False
End Sub
 
Private Sub CboDate_Change()
Dim Ctrl As Control
Dim Colonne As Integer
 
  If Me.CboDate.ListIndex = -1 Then Exit Sub
  With Sheets("Données")
    Ligne = Me.CboDate.ListIndex + 4
    For Each Ctrl In Me.Controls
      Colonne = CInt("0" & Ctrl.Tag)
      If Colonne > 0 Then Ctrl = .Cells(Ligne, Colonne)
    Next Ctrl
  End With
End Sub
Function TrouveType(V)
TrouveType = V
If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 And InStr(TrouveType, ":") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd hh:mm"): Exit Function
If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd"): Exit Function
If IsNumeric(Replace(TrouveType, ".", ",")) = True Then TrouveType = Replace(TrouveType, ",", "."): Exit Function
End Function
 
 
Private Sub CmdModifier_Click()
 
    ' Modifier
    Dim Ctrl As Control
    Dim Colonne As Integer
    Dim Ligne As Long
    Dim x As Integer
 
     If Me.CboDate.ListIndex = -1 Then Exit Sub
     Ligne = Me.CboDate.ListIndex + 4
     With Sheets("Données")
         For Each Ctrl In Me.Controls
            Colonne = CInt("0" & Ctrl.Tag)
             If Colonne > 0 Then
                   .Cells(Ligne, Colonne) = TrouveType(Ctrl)
                 End If
         Next Ctrl
 
               For x = 1 To 2
                     If CDbl("0" & Trim("" & Sheets("Calcul").Range("Rdt_C" & x).Value)) <> 0 Then
                .Cells(Ligne, 8 + x) = Sheets("Calcul").Range("Cout_C" & x) / Sheets("Calcul").Range("Rdt_C" & x)
 
              End If
          Next
 
 
     End With
   Unload Me
 
End Sub
 
 
Private Sub CmdAnnuler_Click()
Unload Me
End Sub

Joël

03/11/2014, 12h36
SfJ5Rpw8

Bonjour,
Rajoute un else a ton if ...si different de 0 tu met la formule sinon 0

Bonjour
Merci Bbil et Robert
Ca me semble bien fonctionner (je reste prudent) avec le code.

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
Private Sub CmdModifier_Click()
 
    ' Modifier
    Dim Ctrl As Control
    Dim Colonne As Integer
    Dim Ligne As Long
    Dim x As Integer
 
     If Me.CboDate.ListIndex = -1 Then Exit Sub
     Ligne = Me.CboDate.ListIndex + 4
     With Sheets("Données")
         For Each Ctrl In Me.Controls
            Colonne = CInt("0" & Ctrl.Tag)
             If Colonne > 0 Then
                   .Cells(Ligne, Colonne) = TrouveType(Ctrl)
                 End If
         Next Ctrl
 
               For x = 1 To 2
                     If CDbl("0" & Trim("" & Sheets("Calcul").Range("Rdt_C" & x).Value)) <> 0 Then
                    .Cells(Ligne, 8 + x) = Sheets("Calcul").Range("Cout_C" & x) / Sheets("Calcul").Range("Rdt_C" & x)
               Else:  .Cells(Ligne, 8 + x) = 0
              End If
          Next
 
 
     End With
   Unload Me
 
End Sub

Joël