Boucle raccourci le programme

blalaa Messages postés 167 Date d'inscription Statut Membre Dernière intervention -
blalaa Messages postés 167 Date d'inscription Statut Membre Dernière intervention - 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 ! )

Afficher la suite

A voir également:

Boucle raccourci le programme
Raccourci retourner écran - Guide
Raccourci pavé tactile - Guide
Raccourci redémarrer pc - Guide
Raccourci clavier espace insécable - Guide
Raccourci word - Guide

1 réponse

Réponse 1 / 1

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 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!!!!

blalaa Messages postés 167 Date d'inscription Statut Membre Dernière intervention

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

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

Votre réponse