Boucle raccourci le programme

blalaa Messages postés 171 Statut Membre -  
blalaa Messages postés 171 Statut Membre -
bonjour

voila jai mis un code pour faire un calcul et je cherche si y a un moyen de mettre une boucle pour reduir mon programme

voici le programme que jai mis , sachant que je vais encore mettre 8 programme pareil pour les autre onglet au lieu "Planification_Autres" ya encore 4 onglet

merci de votre aide 

Sub somme()

Worksheet_Calculate
End Sub



Private Sub Worksheet_Calculate()

Dim sum As Application
Dim x As Integer


For i = 2 To 10000

If Worksheets("Planification_Autres").Cells(i, 15) <> "" Then

x = Left(Worksheets("Planification_Autres").Range("O" & i), 1)
Cells(i, 10) = x



If x / 1 = 1 Then
   If Worksheets("Planification_Autres").Cells(i, 1).Value = "LP_PHEV_EU" Then
   Cells(i, 13) = 1
   Range("b2") = Application.sum(Range("m2:m10000")) ' a modifeier
  
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "SUPPRIME" Then
   Cells(i, 17) = 1
   Range("c2") = Application.sum(Range("q2:q10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "PHEV_LP_LS" Then
   Cells(i, 18) = 1
   Range("c3") = Application.sum(Range("r2:r10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "LP_PHEV_EU_v2" Then
   Cells(i, 19) = 1
   Range("c4") = Application.sum(Range("s2:s10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "LS_PHEV_China6" Then
   Cells(i, 20) = 1
   Range("c5") = Application.sum(Range("t2:t10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "LS_PHEV_EU" Then
   Cells(i, 21) = 1
   Range("c6") = Application.sum(Range("u2:u10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "LS_PHEV_EIC" Then
   Cells(i, 22) = 1
   Range("c7") = Application.sum(Range("v2:v10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "Transversal" Then
   Cells(i, 23) = 1
   Range("c8") = Application.sum(Range("w2:w10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "Divers" Then
   Cells(i, 24) = 1
   Range("c9") = Application.sum(Range("x2:x10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "PHEV_LP_LS_MATRICES" Then
   Cells(i, 25) = 1
   Range("c10") = Application.sum(Range("y2:y10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "ls_PHEV_4x2" Then
   Cells(i, 26) = 1
   Range("c11") = Application.sum(Range("z2:z10000")) ' a modifeier
   
   End If
   
End If


If x / 2 = 1 Then

     If Worksheets("Planification_Autres").Cells(i, 1).Value = "LP_PHEV_EU" Then
     Cells(i, 14) = 1
     Range("b3") = Application.sum(Range("n2:n10000")) ' a modifeier
     
     ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "SUPPRIME" Then
   Cells(i, 27) = 1
   Range("b4") = Application.sum(Range("aa2:aa10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "PHEV_LP_LS" Then
   Cells(i, 28) = 1
   Range("b5") = Application.sum(Range("ab2:ab10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "LP_PHEV_EU_v2" Then
   Cells(i, 29) = 1
   Range("b6") = Application.sum(Range("ac2:ac10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "LS_PHEV_China6" Then
   Cells(i, 30) = 1
   Range("b7") = Application.sum(Range("ad2:ad10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "LS_PHEV_EU" Then
   Cells(i, 31) = 1
   Range("b8") = Application.sum(Range("ae2:ae10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "LS_PHEV_EIC" Then
   Cells(i, 32) = 1
   Range("b9") = Application.sum(Range("af2:af10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "Transversal" Then
   Cells(i, 33) = 1
   Range("b10") = Application.sum(Range("ag2:ag10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "Divers" Then
   Cells(i, 34) = 1
   Range("b11") = Application.sum(Range("ah2:ah10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "PHEV_LP_LS_MATRICES" Then
   Cells(i, 35) = 1
   Range("b12") = Application.sum(Range("ai2:ai10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "ls_PHEV_4x2" Then
   Cells(i, 36) = 1
   Range("b13") = Application.sum(Range("aj2:aj10000")) ' a modifeier
End If
End If




If x / 3 = 1 Then
    If Worksheets("Planification_Autres").Cells(i, 1).Value = "LP_PHEV_EU" Then
    Cells(i, 15) = 1
    Range("d4") = Application.sum(Range("o2:o10000")) ' a modifeier

ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "SUPPRIME" Then
   Cells(i, 37) = 1
   Range("d5") = Application.sum(Range("ak2:ak10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "PHEV_LP_LS" Then
   Cells(i, 38) = 1
   Range("d6") = Application.sum(Range("al2:al10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "LP_PHEV_EU_v2" Then
   Cells(i, 39) = 1
   Range("d7") = Application.sum(Range("am2:am10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "LS_PHEV_China6" Then
   Cells(i, 40) = 1
   Range("d8") = Application.sum(Range("an2:an10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "LS_PHEV_EU" Then
   Cells(i, 41) = 1
   Range("d9") = Application.sum(Range("ao2:ao10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "LS_PHEV_EIC" Then
   Cells(i, 42) = 1
   Range("d10") = Application.sum(Range("ap2:ap10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "Transversal" Then
   Cells(i, 43) = 1
   Range("d11") = Application.sum(Range("aq2:aq10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "Divers" Then
   Cells(i, 44) = 1
   Range("d12") = Application.sum(Range("ar2:ar10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "PHEV_LP_LS_MATRICES" Then
   Cells(i, 45) = 1
   Range("d13") = Application.sum(Range("as2:as10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "ls_PHEV_4x2" Then
   Cells(i, 46) = 1
   Range("d14") = Application.sum(Range("at2:at10000")) ' a modifeier

End If
End If

If x / 4 = 1 Then
   If Worksheets("Planification_Autres").Cells(i, 1).Value = "LP_PHEV_EU" Then
   Cells(i, 46) = 1
   Range("e3") = Application.sum(Range("p2:p10000")) ' a modifeier

   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "SUPPRIME" Then
   Cells(i, 47) = 1
   Range("e4") = Application.sum(Range("au2:au10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "PHEV_LP_LS" Then
   Cells(i, 48) = 1
   Range("e5") = Application.sum(Range("alv2:av10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "LP_PHEV_EU_v2" Then
   Cells(i, 49) = 1
   Range("e6") = Application.sum(Range("aw2:aw10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "LS_PHEV_China6" Then
   Cells(i, 50) = 1
   Range("e7") = Application.sum(Range("ax2:ax10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "LS_PHEV_EU" Then
   Cells(i, 51) = 1
   Range("e8") = Application.sum(Range("ay2:ay10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "LS_PHEV_EIC" Then
   Cells(i, 52) = 1
   Range("e9") = Application.sum(Range("az2:az10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "Transversal" Then
   Cells(i, 53) = 1
   Range("e10") = Application.sum(Range("ba2:ba10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "Divers" Then
   Cells(i, 54) = 1
   Range("e11") = Application.sum(Range("bb2:bb10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "PHEV_LP_LS_MATRICES" Then
   Cells(i, 55) = 1
   Range("e12") = Application.sum(Range("bc2:bc10000")) ' a modifeier
   
   ElseIf Worksheets("Planification_Autres").Cells(i, 1).Value = "ls_PHEV_4x2" Then
   Cells(i, 56) = 1
   Range("e13") = Application.sum(Range("bd2:bd10000")) ' a modifeier

End If
End If
End If
Next


Range("m:m").Value = ""
Range("n:n").Value = ""
Range("o:o").Value = ""
Range("p:p").Value = ""
Range("q:q").Value = ""
Range("r:r").Value = ""
Range("s:s").Value = ""
Range("t:t").Value = ""
Range("u:u").Value = ""
Range("v:v").Value = ""
Range("w:w").Value = ""
Range("x:x").Value = ""
Range("y:y").Value = ""
Range("z:z").Value = ""

Range("aa:aa").Value = ""
Range("ab:ab").Value = ""
Range("ac:ac").Value = ""
Range("ad:ad").Value = ""
Range("ae:ae").Value = ""
Range("af:af").Value = ""
Range("ag:ag").Value = ""
Range("ah:ah").Value = ""
Range("ai:ai").Value = ""
Range("aj:aj").Value = ""

Range("ak:ak").Value = ""
Range("al:al").Value = ""
Range("am:am").Value = ""
Range("an:an").Value = ""
Range("ao:ao").Value = ""
Range("ap:ap").Value = ""
Range("aq:aq").Value = ""
Range("ar:ar").Value = ""
Range("as:as").Value = ""
Range("at:at").Value = ""




Range("j:j") = ""


End Sub

EDIT : Correction des balises de code (ajout du LANGAGE pour avoir la coloration syntaxique ! )

A voir également:

1 réponse

Réponse 1 / 1
cs_Le Pivert Messages postés 8437 Statut Contributeur 729
 
Bonjour,

Pourquoi mettre cela alors que les colonnes se suivent 

Range("m:m").Value = ""
'
'
Range("at:at").Value = ""


une seule ligne suffit: 

 Columns("M:AT").ClearContents


Tu te serais servi de l'enregistreur de macro en sélectionnant toutes tes colonnes et en effaçant le contenu, tu aurais eu la solution.

Tu ne cherches pas assez par toi même et tu comptes sur le Forum pour te donner du tout cuit!!!!
0
blalaa Messages postés 171 Statut Membre
 
bonjour

merci pour ta reponse
sauf que je ne parle pas de la seuxieme partie masi plutot de la premiere partie

merci pour ton aide
0