Boucle raccourci le programme

Fermé

blalaa Messages postés 167 Date d'inscription mercredi 18 avril 2018 Statut Membre Dernière intervention 24 mars 2020 - Modifié le 22 mars 2019 à 10:06
blalaa Messages postés 167 Date d'inscription mercredi 18 avril 2018 Statut Membre Dernière intervention 24 mars 2020 - 23 mars 2019 à 20:31

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 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
22 mars 2019 à 11:04

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

blalaa Messages postés 167 Date d'inscription mercredi 18 avril 2018 Statut Membre Dernière intervention 24 mars 2020
23 mars 2019 à 20:31

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

Discussions similaires

programme qui n'affiche pas le mot secret

Mon pc s'allume et s'éteint en boucle

rachid

Pourquoi Program files (x86) et Programmes?

TV LG affiche le carré non programmé

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

Discussions similaires

Newsletters