Erreur division par zero

[nancy38]

J'essaie d'automatiser des calculs de parts des produits qui se trouvent sur plusieurs tableaux. comme la taille de chaque tableau est différente mais on a toujours une ligne total et une colonne total qui me sert comme référence j'ai utilisé des variables pour que le calcul soit vrai pour chaque tableau.

en plus pour les 2 tableaux que j'ai j'utilise le meme bout de macro et je change juste le numero de ligne/colonne et le nom de variable

Je ne comprends pas pourquoi j'ai erreur divison par zero sur le deuxième tableau

Meci pour votre aide

 

[fhoest]

Re : Erreur division par zero

Bonjour,
Tu as une erreur car ta valeur est égale à zéro .
corrige ton code pour gérer l'erreur.

 For Each cell In Selection
  If cell.Value <> "" Then
   If mondeuxiemetotal = 0 Then mondeuxiemetotal = 1
  mondeuxiemesoutotal = cell.Value
   cell.Offset(1, 0).Value = mondeuxiemesoutotal / mondeuxiemetotal
  
 End If
  Next

A+

 

[nancy38]

Re : Erreur division par zero

Merci merci merci infiniment

))))) Trop fort

 

[nancy38]

Re : Erreur division par zero

J'ai modifié le code et le calcul sur le 2ème tableau marche parfaitement.

Par contre la macro ne fait plus correctement le calcul de la derniere ligne du 1er tableau

elle copie juste les chiffres et les met en %


Des idées pourquoi?

Merci encore une fois

 

[fhoest]

Re : Erreur division par zero

Bonjour,
peux tu donner plus de détails,merci
donne les lignes fausses etc...
A+

 

[fhoest]

Re : Erreur division par zero

Bonjour,
Remplace la macro complète sur ton fichier de départ:
sans tenir compte des lignes de code que j'avais données précédemment

Sub Macro1()
'
' Macro1 Macro
'

'
   

Application.ScreenUpdating = False


      Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.ColumnWidth = 1.29
    Columns("B:B").ColumnWidth = 5.2
    Range("B1:C4").Select
    Selection.ClearContents
    
    
    ActiveWindow.DisplayGridlines = False
    Columns("B:B").Select
    Selection.Font.Bold = True
  
'inserer deux lignes apres chaque total
   
 For Each cell In Range("C5:C65536")

 If cell.Value = "TOTAL" Then
cell.Offset(1, 0).Select
 Selection.EntireRow.Insert
Selection.EntireRow.Insert
End If
Next cell

'inserer du texte dans les 2 lignes


For Each cell In Range("C5:C65536")

 If cell.Value = "TOTAL" Then
cell.Offset(1, 0).Select
  ActiveCell.FormulaR1C1 = "%"
  cell.Offset(2, 0).Select
  ActiveCell.FormulaR1C1 = "evol"
     
   
End If
Next cell


'colorier les cellules media et evol YTD

For Each cell In Range("C5:C65536")

 If cell.Value = "%" Then
cell.Interior.ColorIndex = 43
     
   
End If
Next cell

For Each cell In Range("C5:C65536")

 If cell.Value = "evol" Then
cell.Interior.ColorIndex = 44
     
   
End If
Next cell
'iserer une colonne D et la mettre en blanc

Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.ColumnWidth = 3.14
Columns("D:D").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
'enlever les colonnes autres et total


'separer les deux périodes

Range("F1").Select
Do Until IsEmpty(ActiveCell)
If ActiveCell.Offset(, -1) = ActiveCell Then
ActiveCell.Offset(, 1).Select
Else
ActiveCell.Columns.EntireColumn.Insert
ActiveCell.Offset(, 2).Select
End If
Loop

'Mettre le colonne total en gras


For Each cell In Range("E2:AAA2")

 If cell.Value = "TOTAL" Then
cell.Select
 Selection.EntireColumn.Select
 Selection.Font.Bold = True
End If
Next cell


'inserer une colonne apres total
For Each cell In Range("E2:AAA2")

 If cell.Value = "TOTAL" Then
cell.Offset(0, 1).Select
 ActiveCell.Columns.EntireColumn.Insert
  Selection.ColumnWidth = 10.29
End If
Next cell

'mettre sos pluri apres total

For Each cell In Range("E2:AAA2")

 If cell.Value = "TOTAL" Then
cell.Offset(0, 1).Select
  ActiveCell.FormulaR1C1 = "% autre"
 
End If
Next cell

'compter le nombre de cellules pour P1
ma_valeur = Range("E1").Value

numblanks = 1
For Each c In Range("E1:AAA1")
If c.Value = ma_valeur Then
numblanks = numblanks + 1
End If
Next c


'compter le nombre de cellules pour P2
Range("AAA1").End(xlToLeft).Select
ma_valeur1 = ActiveCell.Value

numblanks1 = 1
For Each c1 In Range("E1:AAA1")
If c1.Value = ma_valeur1 Then
numblanks1 = numblanks1 + 1
End If
Next c1

'color la P1
For Each cell In Range("C5:C65536")

 If cell.Value = "%" Then
cell.Offset(0, 2).Select

ActiveCell.Resize(, numblanks).Interior.ColorIndex = 43

End If

Next

'color la P2
For Each cell In Range("C5:C65536")

 If cell.Value = "%" Then
cell.Offset(0, 3 + numblanks).Select

ActiveCell.Resize(, numblanks1).Interior.ColorIndex = 43

End If

Next


'color la P2
For Each cell In Range("C5:C65536")

 If cell.Value = "evol" Then
cell.Offset(0, 3 + numblanks).Select

ActiveCell.Resize(, numblanks1).Interior.ColorIndex = 44

End If

Next


'calculer les % de la P1

For i = 5 To 300

 If Range("C" & i).Value = "TOTAL" And Range("C" & i).Offset(0, numblanks) <> "" Then
    Range("C" & i).Offset(0, numblanks).Select
   montotal = ActiveCell.Value
   End If

 If Range("C" & i).Value = "TOTAL" And Range("C" & i).Offset(0, numblanks) <> "" Then
    Range("C" & i).Offset(0, 2).Select
   ActiveCell.Resize(, numblanks).Select
   End If
   For Each cell In Selection
   If cell.Value <> "" Then
   
   monsoutotal = cell.Value
   cell.Offset(1, 0).Value = monsoutotal / montotal
   
  
  End If
   Next
Next i




'calculer les % de la P2

For i = 5 To 300

 If Range("C" & i).Value = "TOTAL" And Range("C" & i).Offset(0, numblanks + numblanks1 + 1) <> "" Then
    Range("C" & i).Offset(0, numblanks + numblanks1 + 1).Select
   mondeuxiemetotal = ActiveCell.Value
   
Else:
GoTo ici
End If
   
 If Range("C" & i).Value = "TOTAL" And Range("C" & i).Offset(0, numblanks + numblanks1 + 1) <> "" Then
   Range("C" & i).Offset(0, 3 + numblanks).Select
  ActiveCell.Resize(, numblanks1).Select
  End If
  For Each cell In Selection
  If cell.Value <> "" Then
   
  mondeuxiemesoutotal = cell.Value
  cell.Offset(1, 0).Value = mondeuxiemesoutotal / mondeuxiemetotal
  
 End If
  Next
ici:
Next i

For Each cell In Range("C5:C65536")

 If cell.Value = "%" Then
   
  cell.Select
 Selection.EntireRow.Select
 
   
   Selection.Style = "Percent"
End If

Next
Application.ScreenUpdating = True
End Sub

j'ai ajouter une gestion sur la boucle if qui contient la mise à jour de ta variable mondeuxiemetotal qui était toujours à zéro. avec les instructions:

for i= 5 to ...
if ... then ...
else:
goto ici
end if
....
ici:
next i

en cas d'erreur on saute la boucle pour incrémenter le i
J'ai aussi ajouter les instruction

Application.screenupdating= false
 'début de macro 
'et
Application.screenupdating=true 
'en fin de macro pour accélérer le code et éviter le scintillement de ta page lors de l'exécution du code

A bientôt.