Alléger le code

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 - 11 avril 2019 à 09:57

bonjour

jai cree un code avec une boucle while pour alleger mon code mais ca ne marche pas
jarrive pas a trouver l'erreur

voici le code originale qui fonctionne tres bien

'CODE 
Sub essai_qpdc()
Dim a As String



a = Worksheets("NEW_VB_config").Range("o" & 2) '1feuil
b = Worksheets("NEW_VB_config").Range("o" & 3) '2feuil
c = Worksheets("NEW_VB_config").Range("o" & 4) '3feuil
d = Worksheets("NEW_VB_config").Range("o" & 5) '4feuil
E = Worksheets("NEW_VB_config").Range("o" & 6) '5feuil
f = Worksheets("NEW_VB_config").Range("o" & 7) '6feuil
g = Worksheets("NEW_VB_config").Range("o" & 8) '7feuil
h = Worksheets("NEW_VB_config").Range("o" & 9) '8feuil
i = Worksheets("NEW_VB_config").Range("o" & 10) '9feuil
j = Worksheets("NEW_VB_config").Range("o" & 11) '10feuil
k = Worksheets("NEW_VB_config").Range("o" & 12) '11feuil




For i = 2 To 10000

'1 er feuil
If Worksheets("NEW_VB_config").Range("o" & 2) <> "" Then
'a = Worksheets("NEW_VB_config").Range("o" & 2)

If Worksheets(a).Range("n" & i) <> "" Then

x = Left(Worksheets(a).Range("n" & i), 1)
y = Left(Worksheets(a).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(a).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(a).Range("n" & i), 1)

    If Worksheets(a).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("aa" & i) = x
             Range("w2") = Application.sum(Range("aa2:aa10000"))
             ElseIf x = 2 Then
             Range("ab" & i) = x
             Range("w3") = Application.sum(Range("ab2:ab10000")) / 2
             ElseIf x = 3 Then
             Range("ac" & i) = x
             Range("w4") = Application.sum(Range("ac2:ac10000")) / 3
             ElseIf x = 4 Then
             Range("ad" & i) = x
             Range("w5") = Application.sum(Range("ad2:ad10000")) / 4
             End If
             
             If y1 = 1 Then
             Range("ae" & i) = y1
             Range("x2") = Application.sum(Range("ae2:ae10000"))
             ElseIf y1 = 2 Then
             Range("af" & i) = y1
             Range("x3") = Application.sum(Range("af2:af10000")) / 2
             ElseIf y1 = 3 Then
             Range("ag" & i) = y1
             Range("x4") = Application.sum(Range("ag2:ag10000")) / 3
             ElseIf y1 = 4 Then
             Range("ah" & i) = y1
             Range("x5") = Application.sum(Range("ah2:ah10000")) / 4
             End If
             
             
             If y22 = 1 Then
             Range("ai" & i) = y22
             Range("y2") = Application.sum(Range("ai2:ai10000"))
             ElseIf y22 = 2 Then
             Range("aj" & i) = y22
             Range("y3") = Application.sum(Range("aj2:aj10000")) / 2
             ElseIf y22 = 3 Then
             Range("ak" & i) = y22
             Range("y4") = Application.sum(Range("ak2:ak10000")) / 3
             ElseIf y22 = 4 Then
             Range("al" & i) = y22
             Range("y5") = Application.sum(Range("al2:al10000")) / 4
             End If
             
             If y3 = 1 Then
             Range("am" & i) = y3
             Range("z2") = Application.sum(Range("am2:am10000"))
             ElseIf y3 = 2 Then
             Range("an" & i) = y3
             Range("z3") = Application.sum(Range("an2:an10000")) / 2
             ElseIf y3 = 3 Then
             Range("ao" & i) = y3
             Range("z4") = Application.sum(Range("ao2:ao10000")) / 3
             ElseIf y3 = 4 Then
             Range("ap" & i) = y3
             Range("z5") = Application.sum(Range("ap2:ap10000")) / 4
             End If
             
     End If
End If
End If

' 2 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 3) <> "" Then
'b = Worksheets("NEW_VB_config").Range("o" & 3)
If Worksheets(b).Range("n" & i) <> "" Then

x = Left(Worksheets(b).Range("n" & i), 1)
y = Left(Worksheets(b).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(b).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(b).Range("n" & i), 1)

    If Worksheets(b).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("aq" & i) = x
             Range("w6") = Application.sum(Range("aq2:aq10000"))
             ElseIf x = 2 Then
             Range("ar" & i) = x
             Range("w7") = Application.sum(Range("ar2:ar10000")) / 2
             ElseIf x = 3 Then
             Range("as" & i) = x
             Range("w8") = Application.sum(Range("as2:as10000")) / 3
             ElseIf x = 4 Then
             Range("at" & i) = x
             Range("w9") = Application.sum(Range("at2:at10000")) / 4
             End If
             
             If y1 = 1 Then
             Range("au" & i) = y1
             Range("x6") = Application.sum(Range("au2:au10000"))
             ElseIf y1 = 2 Then
             Range("av" & i) = y1
             Range("x7") = Application.sum(Range("av2:av10000")) / 2
             ElseIf y1 = 3 Then
             Range("aw" & i) = y1
             Range("x8") = Application.sum(Range("aw2:aw10000")) / 3
             ElseIf y1 = 4 Then
             Range("ax" & i) = y1
             Range("x9") = Application.sum(Range("ax2:ax10000")) / 4
             End If
             
             
             If y22 = 1 Then
             Range("ay" & i) = y22
             Range("y6") = Application.sum(Range("ay2:ay10000"))
             ElseIf y22 = 2 Then
             Range("az" & i) = y22
             Range("y7") = Application.sum(Range("az2:az10000")) / 2
             ElseIf y22 = 3 Then
             Range("ba" & i) = y22
             Range("y8") = Application.sum(Range("ba2:ba10000")) / 3
             ElseIf y22 = 4 Then
             Range("bb" & i) = y22
             Range("y9") = Application.sum(Range("bb2:bb10000")) / 4
             End If
             
             If y3 = 1 Then
             Range("bc" & i) = y3
             Range("z6") = Application.sum(Range("bc2:bc10000"))
             ElseIf y3 = 2 Then
             Range("bd" & i) = y3
             Range("z7") = Application.sum(Range("bd2:bd10000")) / 2
             ElseIf y3 = 3 Then
             Range("be" & i) = y3
             Range("z8") = Application.sum(Range("be2:be10000")) / 3
             ElseIf y3 = 4 Then
             Range("bf" & i) = y3
             Range("z9") = Application.sum(Range("bf2:bf10000")) / 4
             End If
             
     End If
End If
End If


' 3 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 4) <> "" Then
'c = Worksheets("NEW_VB_config").Range("o" & 4)
If Worksheets(c).Range("n" & i) <> "" Then

x = Left(Worksheets(c).Range("n" & i), 1)
y = Left(Worksheets(c).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(c).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(c).Range("n" & i), 1)

    If Worksheets(c).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("bg" & i) = x
             Range("w10") = Application.sum(Range("bg2:bg10000"))
             ElseIf x = 2 Then
             Range("bh" & i) = x
             Range("w11") = Application.sum(Range("bh2:bh10000")) / 2
             ElseIf x = 3 Then
             Range("bi" & i) = x
             Range("w12") = Application.sum(Range("bi2:bi10000")) / 3
             ElseIf x = 4 Then
             Range("bj" & i) = x
             Range("w13") = Application.sum(Range("bj2:bj10000")) / 4
             End If
             
             If y1 = 1 Then
             Range("bk" & i) = y1
             Range("x10") = Application.sum(Range("bk2:bk10000"))
             ElseIf y1 = 2 Then
             Range("bl" & i) = y1
             Range("x11") = Application.sum(Range("bl2:bl10000")) / 2
             ElseIf y1 = 3 Then
             Range("bm" & i) = y1
             Range("x12") = Application.sum(Range("bm2:bm10000")) / 3
             ElseIf y1 = 4 Then
             Range("bn" & i) = y1
             Range("x13") = Application.sum(Range("bn2:bn10000")) / 4
             End If
             
             
             If y22 = 1 Then
             Range("bo" & i) = y22
             Range("y10") = Application.sum(Range("bo2:bo10000"))
             ElseIf y22 = 2 Then
             Range("bp" & i) = y22
             Range("y11") = Application.sum(Range("bp2:bp10000")) / 2
             ElseIf y22 = 3 Then
             Range("bq" & i) = y22
             Range("y12") = Application.sum(Range("bq2:bq10000")) / 3
             ElseIf y22 = 4 Then
             Range("br" & i) = y22
             Range("y13") = Application.sum(Range("br2:br10000")) / 4
             End If
             
             If y3 = 1 Then
             Range("bs" & i) = y3
             Range("z10") = Application.sum(Range("bs2:bs10000"))
             ElseIf y3 = 2 Then
             Range("bt" & i) = y3
             Range("z11") = Application.sum(Range("bt2:bt10000")) / 2
             ElseIf y3 = 3 Then
             Range("bu" & i) = y3
             Range("z12") = Application.sum(Range("bu2:bu10000")) / 3
             ElseIf y3 = 4 Then
             Range("bv" & i) = y3
             Range("z13") = Application.sum(Range("bv2:bv10000")) / 4
             End If
             
     End If
End If
End If

' 4 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 5) <> "" Then
'd = Worksheets("NEW_VB_config").Range("o" & 5)
If Worksheets(d).Range("n" & i) <> "" Then

x = Left(Worksheets(d).Range("n" & i), 1)
y = Left(Worksheets(d).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(d).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(d).Range("n" & i), 1)

    If Worksheets(d).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("bw" & i) = x
             Range("w14") = Application.sum(Range("bw2:bw10000"))
             ElseIf x = 2 Then
             Range("bx" & i) = x
             Range("w15") = Application.sum(Range("bx2:bx10000")) / 2
             ElseIf x = 3 Then
             Range("by" & i) = x
             Range("w16") = Application.sum(Range("by2:by10000")) / 3
             ElseIf x = 4 Then
             Range("bz" & i) = x
             Range("w17") = Application.sum(Range("bz2:bz10000")) / 4
             End If
             
             If y1 = 1 Then
             Range("ca" & i) = y1
             Range("x14") = Application.sum(Range("ca2:ca10000"))
             ElseIf y1 = 2 Then
             Range("cb" & i) = y1
             Range("x15") = Application.sum(Range("cb2:cb10000")) / 2
             ElseIf y1 = 3 Then
             Range("cc" & i) = y1
             Range("x16") = Application.sum(Range("cc2:cc10000")) / 3
             ElseIf y1 = 4 Then
             Range("cd" & i) = y1
             Range("x17") = Application.sum(Range("cd2:cd10000")) / 4
             End If
             
             
             If y22 = 1 Then
             Range("ce" & i) = y22
             Range("y14") = Application.sum(Range("ce2:ce10000"))
             ElseIf y22 = 2 Then
             Range("cf" & i) = y22
             Range("y15") = Application.sum(Range("cf2:cf10000")) / 2
             ElseIf y22 = 3 Then
             Range("cg" & i) = y22
             Range("y16") = Application.sum(Range("cg2:cg10000")) / 3
             ElseIf y22 = 4 Then
             Range("ch" & i) = y22
             Range("y17") = Application.sum(Range("ch2:ch10000")) / 4
             End If
             
             If y3 = 1 Then
             Range("ci" & i) = y3
             Range("z14") = Application.sum(Range("ci2:ci10000"))
             ElseIf y3 = 2 Then
             Range("cj" & i) = y3
             Range("z15") = Application.sum(Range("cj2:cj10000")) / 2
             ElseIf y3 = 3 Then
             Range("ck" & i) = y3
             Range("z16") = Application.sum(Range("ck2:ck10000")) / 3
             ElseIf y3 = 4 Then
             Range("cl" & i) = y3
             Range("z17") = Application.sum(Range("cl2:cl10000")) / 4
             End If
             
     End If
End If
End If

' 5 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 6) <> "" Then
'E = Worksheets("NEW_VB_config").Range("o" & 6)
If Worksheets(E).Range("n" & i) <> "" Then

x = Left(Worksheets(E).Range("n" & i), 1)
y = Left(Worksheets(E).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(E).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(E).Range("n" & i), 1)

    If Worksheets(E).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("cm" & i) = x
             Range("w18") = Application.sum(Range("cm2:cm10000"))
             ElseIf x = 2 Then
             Range("cn" & i) = x
             Range("w19") = Application.sum(Range("cn2:cn10000")) / 2
             ElseIf x = 3 Then
             Range("co" & i) = x
             Range("w20") = Application.sum(Range("co2:co10000")) / 3
             ElseIf x = 4 Then
             Range("cp" & i) = x
             Range("w21") = Application.sum(Range("cp2:cp10000")) / 4
             End If
             
             If y1 = 1 Then
             Range("cq" & i) = y1
             Range("x18") = Application.sum(Range("cq2:cq10000"))
             ElseIf y1 = 2 Then
             Range("cr" & i) = y1
             Range("x19") = Application.sum(Range("cr2:cr10000")) / 2
             ElseIf y1 = 3 Then
             Range("cs" & i) = y1
             Range("x20") = Application.sum(Range("cs2:cs10000")) / 3
             ElseIf y1 = 4 Then
             Range("ct" & i) = y1
             Range("x21") = Application.sum(Range("ct2:ct10000")) / 4
             End If
             
             
             If y22 = 1 Then
             Range("cu" & i) = y22
             Range("y18") = Application.sum(Range("cu2:cu10000"))
             ElseIf y22 = 2 Then
             Range("cv" & i) = y22
             Range("y19") = Application.sum(Range("cv2:cv10000")) / 2
             ElseIf y22 = 3 Then
             Range("cw" & i) = y22
             Range("y20") = Application.sum(Range("cw2:cw10000")) / 3
             ElseIf y22 = 4 Then
             Range("cx" & i) = y22
             Range("y21") = Application.sum(Range("cx2:cx10000")) / 4
             End If
             
             If y3 = 1 Then
             Range("cy" & i) = y3
             Range("z18") = Application.sum(Range("cy2:cy10000"))
             ElseIf y3 = 2 Then
             Range("cz" & i) = y3
             Range("z19") = Application.sum(Range("cz2:cz10000")) / 2
             ElseIf y3 = 3 Then
             Range("da" & i) = y3
             Range("z20") = Application.sum(Range("da2:da10000")) / 3
             ElseIf y3 = 4 Then
             Range("db" & i) = y3
             Range("z21") = Application.sum(Range("db2:db10000")) / 4
             End If
             
     End If
End If
End If

' 6 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 7) <> "" Then
'f = Worksheets("NEW_VB_config").Range("o" & 7)


If Worksheets(f).Range("n" & i) <> "" Then

x = Left(Worksheets(f).Range("n" & i), 1)
y = Left(Worksheets(f).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(f).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(f).Range("n" & i), 1)

    If Worksheets(f).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("dc" & i) = x
             Range("w22") = Application.sum(Range("dc2:dc10000"))
             ElseIf x = 2 Then
             Range("dd" & i) = x
             Range("w23") = Application.sum(Range("dd2:dd10000")) / 2
             ElseIf x = 3 Then
             Range("de" & i) = x
             Range("w24") = Application.sum(Range("de2:de10000")) / 3
             ElseIf x = 4 Then
             Range("df" & i) = x
             Range("w25") = Application.sum(Range("df2:df10000")) / 4
             End If
             
             If y1 = 1 Then
             Range("dg" & i) = y1
             Range("x22") = Application.sum(Range("dg2:dg10000"))
             ElseIf y1 = 2 Then
             Range("dh" & i) = y1
             Range("x23") = Application.sum(Range("dh2:dh10000")) / 2
             ElseIf y1 = 3 Then
             Range("di" & i) = y1
             Range("x24") = Application.sum(Range("di2:di10000")) / 3
             ElseIf y1 = 4 Then
             Range("dj" & i) = y1
             Range("x25") = Application.sum(Range("dj2:dj10000")) / 4
             End If
             
             
             If y22 = 1 Then
             Range("dk" & i) = y22
             Range("y22") = Application.sum(Range("dk2:dk10000"))
             ElseIf y22 = 2 Then
             Range("dl" & i) = y22
             Range("y23") = Application.sum(Range("dl2:dl10000")) / 2
             ElseIf y22 = 3 Then
             Range("dm" & i) = y22
             Range("y24") = Application.sum(Range("dm2:dm10000")) / 3
             ElseIf y22 = 4 Then
             Range("dn" & i) = y22
             Range("y25") = Application.sum(Range("dn2:dn10000")) / 4
             End If
             
             If y3 = 1 Then
             Range("do" & i) = y3
             Range("z22") = Application.sum(Range("do2:do10000"))
             ElseIf y3 = 2 Then
             Range("dp" & i) = y3
             Range("z23") = Application.sum(Range("dp2:dp10000")) / 2
             ElseIf y3 = 3 Then
             Range("dq" & i) = y3
             Range("z24") = Application.sum(Range("dq2:dq10000")) / 3
             ElseIf y3 = 4 Then
             Range("dr" & i) = y3
             Range("z25") = Application.sum(Range("drl2:drl10000")) / 4
             End If
             
     End If
End If

End If

' 7 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 8) <> "" Then
'g = Worksheets("NEW_VB_config").Range("o" & 8)


If Worksheets(g).Range("n" & i) <> "" Then

x = Left(Worksheets(g).Range("n" & i), 1)
y = Left(Worksheets(g).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(g).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(g).Range("n" & i), 1)

    If Worksheets(g).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("ds" & i) = x
             Range("w26") = Application.sum(Range("ds2:ds10000"))
             ElseIf x = 2 Then
             Range("dt" & i) = x
             Range("w27") = Application.sum(Range("dt2:dt10000")) / 2
             ElseIf x = 3 Then
             Range("du" & i) = x
             Range("w28") = Application.sum(Range("du2:du10000")) / 3
             ElseIf x = 4 Then
             Range("dv" & i) = x
             Range("w29") = Application.sum(Range("dv2:dv10000")) / 4
             End If
             
             If y1 = 1 Then
             Range("dw" & i) = y1
             Range("x26") = Application.sum(Range("dw2:dw10000"))
             ElseIf y1 = 2 Then
             Range("dx" & i) = y1
             Range("x27") = Application.sum(Range("dx2:dx10000")) / 2
             ElseIf y1 = 3 Then
             Range("dy" & i) = y1
             Range("x28") = Application.sum(Range("dy2:dy10000")) / 3
             ElseIf y1 = 4 Then
             Range("dz" & i) = y1
             Range("x29") = Application.sum(Range("dz2:dz10000")) / 4
             End If
             
             
             If y22 = 1 Then
             Range("ea" & i) = y22
             Range("y26") = Application.sum(Range("ea2:ea10000"))
             ElseIf y22 = 2 Then
             Range("eb" & i) = y22
             Range("y27") = Application.sum(Range("eb2:eb10000")) / 2
             ElseIf y22 = 3 Then
             Range("ec" & i) = y22
             Range("y28") = Application.sum(Range("ec2:ec10000")) / 3
             ElseIf y22 = 4 Then
             Range("ed" & i) = y22
             Range("y29") = Application.sum(Range("ed2:ed10000")) / 4
             End If
             
             If y3 = 1 Then
             Range("ee" & i) = y3
             Range("z26") = Application.sum(Range("ee2:ee10000"))
             ElseIf y3 = 2 Then
             Range("ef" & i) = y3
             Range("z27") = Application.sum(Range("ef2:ef10000")) / 2
             ElseIf y3 = 3 Then
             Range("eg" & i) = y3
             Range("z28") = Application.sum(Range("eg2:eg10000")) / 3
             ElseIf y3 = 4 Then
             Range("eh" & i) = y3
             Range("z29") = Application.sum(Range("ehl2:ehl10000")) / 4
             End If
             
     End If
End If
End If


' 8 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 9) <> "" Then
'h = Worksheets("NEW_VB_config").Range("o" & 9)


If Worksheets(h).Range("n" & i) <> "" Then

x = Left(Worksheets(h).Range("n" & i), 1)
y = Left(Worksheets(h).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(h).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(h).Range("n" & i), 1)

    If Worksheets(h).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("ei" & i) = x
             Range("w30") = Application.sum(Range("ei2:ei10000"))
             ElseIf x = 2 Then
             Range("ej" & i) = x
             Range("w31") = Application.sum(Range("ej2:ej10000")) / 2
             ElseIf x = 3 Then
             Range("ek" & i) = x
             Range("w32") = Application.sum(Range("ek2:ek10000")) / 3
             ElseIf x = 4 Then
             Range("el" & i) = x
             Range("w33") = Application.sum(Range("el2:el10000")) / 4
             End If
             
             If y1 = 1 Then
             Range("em" & i) = y1
             Range("x30") = Application.sum(Range("em2:em10000"))
             ElseIf y1 = 2 Then
             Range("en" & i) = y1
             Range("x31") = Application.sum(Range("en2:en10000")) / 2
             ElseIf y1 = 3 Then
             Range("eo" & i) = y1
             Range("x32") = Application.sum(Range("eo2:eo10000")) / 3
             ElseIf y1 = 4 Then
             Range("ep" & i) = y1
             Range("x33") = Application.sum(Range("ep2:ep10000")) / 4
             End If
             
             
             If y22 = 1 Then
             Range("eq" & i) = y22
             Range("y30") = Application.sum(Range("eq2:eq10000"))
             ElseIf y22 = 2 Then
             Range("er" & i) = y22
             Range("y31") = Application.sum(Range("er2:er10000")) / 2
             ElseIf y22 = 3 Then
             Range("es" & i) = y22
             Range("y32") = Application.sum(Range("es2:es10000")) / 3
             ElseIf y22 = 4 Then
             Range("et" & i) = y22
             Range("y33") = Application.sum(Range("et2:et10000")) / 4
             End If
             
             If y3 = 1 Then
             Range("eu" & i) = y3
             Range("z30") = Application.sum(Range("eu2:eu10000"))
             ElseIf y3 = 2 Then
             Range("ev" & i) = y3
             Range("z31") = Application.sum(Range("ev2:ev10000")) / 2
             ElseIf y3 = 3 Then
             Range("ew" & i) = y3
             Range("z32") = Application.sum(Range("ew2:ew10000")) / 3
             ElseIf y3 = 4 Then
             Range("ex" & i) = y3
             Range("z33") = Application.sum(Range("exl2:exl10000")) / 4
             End If
             
     End If
End If
End If


' 9 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 10) <> "" Then
'i = Worksheets("NEW_VB_config").Range("o" & 10)


If Worksheets(i).Range("n" & i) <> "" Then

x = Left(Worksheets(i).Range("n" & i), 1)
y = Left(Worksheets(i).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(i).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(i).Range("n" & i), 1)

    If Worksheets(i).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("ey" & i) = x
             Range("w34") = Application.sum(Range("ey2:ey10000"))
             ElseIf x = 2 Then
             Range("ez" & i) = x
             Range("w35") = Application.sum(Range("ez2:ez10000")) / 2
             ElseIf x = 3 Then
             Range("fa" & i) = x
             Range("w36") = Application.sum(Range("fa2:fa10000")) / 3
             ElseIf x = 4 Then
             Range("fb" & i) = x
             Range("w37") = Application.sum(Range("fb2:fb10000")) / 4
             End If
             
             If y1 = 1 Then
             Range("fc" & i) = y1
             Range("x34") = Application.sum(Range("fc2:fc10000"))
             ElseIf y1 = 2 Then
             Range("fd" & i) = y1
             Range("x35") = Application.sum(Range("fd2:fd10000")) / 2
             ElseIf y1 = 3 Then
             Range("fe" & i) = y1
             Range("x36") = Application.sum(Range("fe2:fe10000")) / 3
             ElseIf y1 = 4 Then
             Range("ff" & i) = y1
             Range("x37") = Application.sum(Range("ff2:ff10000")) / 4
             End If
             
             
             If y22 = 1 Then
             Range("fg" & i) = y22
             Range("y34") = Application.sum(Range("fg2:fg10000"))
             ElseIf y22 = 2 Then
             Range("fh" & i) = y22
             Range("y35") = Application.sum(Range("fh2:fh10000")) / 2
             ElseIf y22 = 3 Then
             Range("fi" & i) = y22
             Range("y36") = Application.sum(Range("fi2:fi10000")) / 3
             ElseIf y22 = 4 Then
             Range("fj" & i) = y22
             Range("y37") = Application.sum(Range("fj2:fj10000")) / 4
             End If
             
             If y3 = 1 Then
             Range("fk" & i) = y3
             Range("z34") = Application.sum(Range("fk2:fk10000"))
             ElseIf y3 = 2 Then
             Range("fl" & i) = y3
             Range("z35") = Application.sum(Range("fl2:fl10000")) / 2
             ElseIf y3 = 3 Then
             Range("fm" & i) = y3
             Range("z36") = Application.sum(Range("fm2:fm10000")) / 3
             ElseIf y3 = 4 Then
             Range("fn" & i) = y3
             Range("z37") = Application.sum(Range("fnl2:fnl10000")) / 4
             End If
             
     End If
End If
End If



' 10 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 11) <> "" Then
'j = Worksheets("NEW_VB_config").Range("o" & 11)


If Worksheets(j).Range("n" & i) <> "" Then

x = Left(Worksheets(j).Range("n" & i), 1)
y = Left(Worksheets(j).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(j).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(j).Range("n" & i), 1)

    If Worksheets(j).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("fo" & i) = x
             Range("w38") = Application.sum(Range("fo2:fo10000"))
             ElseIf x = 2 Then
             Range("fp" & i) = x
             Range("w39") = Application.sum(Range("fp2:fp10000")) / 2
             ElseIf x = 3 Then
             Range("fq" & i) = x
             Range("w40") = Application.sum(Range("fq2:fq10000")) / 3
             ElseIf x = 4 Then
             Range("fr" & i) = x
             Range("w41") = Application.sum(Range("fr2:fr10000")) / 4
             End If
             
             If y1 = 1 Then
             Range("fs" & i) = y1
             Range("x38") = Application.sum(Range("fs2:fs10000"))
             ElseIf y1 = 2 Then
             Range("ft" & i) = y1
             Range("x39") = Application.sum(Range("ft2:ft10000")) / 2
             ElseIf y1 = 3 Then
             Range("fu" & i) = y1
             Range("x40") = Application.sum(Range("fu2:fu10000")) / 3
             ElseIf y1 = 4 Then
             Range("fv" & i) = y1
             Range("x41") = Application.sum(Range("fv2:fv10000")) / 4
             End If
             
             
             If y22 = 1 Then
             Range("fw" & i) = y22
             Range("y38") = Application.sum(Range("fw2:fw10000"))
             ElseIf y22 = 2 Then
             Range("fx" & i) = y22
             Range("y39") = Application.sum(Range("fx2:fx10000")) / 2
             ElseIf y22 = 3 Then
             Range("fy" & i) = y22
             Range("y40") = Application.sum(Range("fy2:fy10000")) / 3
             ElseIf y22 = 4 Then
             Range("fz" & i) = y22
             Range("y41") = Application.sum(Range("fz2:fz10000")) / 4
             End If
             
             If y3 = 1 Then
             Range("ga" & i) = y3
             Range("z38") = Application.sum(Range("ga2:ga10000"))
             ElseIf y3 = 2 Then
             Range("gb" & i) = y3
             Range("z39") = Application.sum(Range("gb2:gb10000")) / 2
             ElseIf y3 = 3 Then
             Range("gc" & i) = y3
             Range("z40") = Application.sum(Range("gc2:gc10000")) / 3
             ElseIf y3 = 4 Then
             Range("gd" & i) = y3
             Range("z41") = Application.sum(Range("gdl2:gdl10000")) / 4
             End If
             
     End If
End If
End If


' 11 eme feuille

If Worksheets("NEW_VB_config").Range("o" & 12) <> "" Then
'k = Worksheets("NEW_VB_config").Range("o" & 12)


If Worksheets(k).Range("n" & i) <> "" Then

x = Left(Worksheets(k).Range("n" & i), 1)
y = Left(Worksheets(k).Range("n" & i), 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(k).Range("n" & i), 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(k).Range("n" & i), 1)

    If Worksheets(k).Range("a" & i) = Range("a1") Then

          If x = 1 Then
             Range("ge" & i) = x
             Range("w42") = Application.sum(Range("ge2:fo10000"))
             ElseIf x = 2 Then
             Range("gf" & i) = x
             Range("w43") = Application.sum(Range("gf2:gf10000")) / 2
             ElseIf x = 3 Then
             Range("gg" & i) = x
             Range("w44") = Application.sum(Range("gg2:gg10000")) / 3
             ElseIf x = 4 Then
             Range("gh" & i) = x
             Range("w45") = Application.sum(Range("gh2:gh10000")) / 4
             End If
             
             If y1 = 1 Then
             Range("gi" & i) = y1
             Range("x42") = Application.sum(Range("gi2:gi10000"))
             ElseIf y1 = 2 Then
             Range("gj" & i) = y1
             Range("x43") = Application.sum(Range("gj2:gj10000")) / 2
             ElseIf y1 = 3 Then
             Range("gk" & i) = y1
             Range("x44") = Application.sum(Range("gk2:gk10000")) / 3
             ElseIf y1 = 4 Then
             Range("gl" & i) = y1
             Range("x45") = Application.sum(Range("gl2:gl10000")) / 4
             End If
             
             
             If y22 = 1 Then
             Range("gm" & i) = y22
             Range("y42") = Application.sum(Range("gm2:gm10000"))
             ElseIf y22 = 2 Then
             Range("gn" & i) = y22
             Range("y43") = Application.sum(Range("gn2:gn10000")) / 2
             ElseIf y22 = 3 Then
             Range("go" & i) = y22
             Range("y44") = Application.sum(Range("go2:go10000")) / 3
             ElseIf y22 = 4 Then
             Range("gp" & i) = y22
             Range("y45") = Application.sum(Range("gp2:gp10000")) / 4
             End If
             
             If y3 = 1 Then
             Range("gq" & i) = y3
             Range("z42") = Application.sum(Range("gq2:gq10000"))
             ElseIf y3 = 2 Then
             Range("gr" & i) = y3
             Range("z43") = Application.sum(Range("gr2:gr10000")) / 2
             ElseIf y3 = 3 Then
             Range("gs" & i) = y3
             Range("z44") = Application.sum(Range("gs2:gs10000")) / 3
             ElseIf y3 = 4 Then
             Range("gt" & i) = y3
             Range("z45") = Application.sum(Range("gtl2:gtl10000")) / 4
             End If
             
     End If
End If
End If

Next

'For i = 0 To 3
    'For j = 0 To 3
        'tst = Range("w2").offset(i, j).Value
        'For k = 1 To 10
            'tst = tst + Range("w2").offset(k * 4, j).Value
        'Next k
       ' Range("B2").offset(i, j) = tst
    'Next j
'Next i

Range("b2") = Range("w2") + Range("w6") + Range("w10") + Range("w14") + Range("w18") + Range("w22") + Range("w26") + Range("w30") + Range("w34") + Range("w38") + Range("w42")
Range("b3") = Range("w3") + Range("w7") + Range("w11") + Range("w15") + Range("w19") + Range("w23") + Range("w27") + Range("w31") + Range("w35") + Range("w39") + Range("w43")
Range("b4") = Range("w4") + Range("w8") + Range("w12") + Range("w16") + Range("w20") + Range("w24") + Range("w28") + Range("w32") + Range("w36") + Range("w40") + Range("w44")
Range("b5") = Range("w5") + Range("w9") + Range("w13") + Range("w17") + Range("w21") + Range("w25") + Range("w29") + Range("w33") + Range("w37") + Range("w41") + Range("w45")


Range("c2") = Range("x2") + Range("x6") + Range("x10") + Range("x14") + Range("x18") + Range("x22") + Range("x26") + Range("x30") + Range("x34") + Range("x38") + Range("x42")
Range("c3") = Range("x3") + Range("x7") + Range("x11") + Range("x15") + Range("x19") + Range("x23") + Range("x27") + Range("x30") + Range("x35") + Range("x39") + Range("x43")
Range("c4") = Range("x4") + Range("x8") + Range("x12") + Range("x16") + Range("x20") + Range("x24") + Range("x28") + Range("x30") + Range("x36") + Range("x40") + Range("x44")
Range("c5") = Range("x5") + Range("x9") + Range("x13") + Range("x17") + Range("x21") + Range("x25") + Range("x29") + Range("x30") + Range("x37") + Range("x41") + Range("x45")

Range("d2") = Range("y2") + Range("y6") + Range("y10") + Range("y14") + Range("y18") + Range("y22") + Range("y26") + Range("y30") + Range("y34") + Range("y38") + Range("y42")
Range("d3") = Range("y3") + Range("y7") + Range("y11") + Range("y15") + Range("y19") + Range("y23") + Range("y27") + Range("y30") + Range("y35") + Range("y39") + Range("y43")
Range("d4") = Range("y4") + Range("y8") + Range("y12") + Range("y16") + Range("y20") + Range("y24") + Range("y28") + Range("y30") + Range("y36") + Range("y40") + Range("y44")
Range("d5") = Range("y5") + Range("y9") + Range("y13") + Range("y17") + Range("y21") + Range("y25") + Range("y29") + Range("y30") + Range("y37") + Range("y41") + Range("y45")

Range("e2") = Range("z2") + Range("z6") + Range("z10") + Range("z14") + Range("z18") + Range("z22") + Range("z26") + Range("z30") + Range("z34") + Range("z38") + Range("z42")
Range("e3") = Range("z3") + Range("z7") + Range("z11") + Range("z15") + Range("z19") + Range("z23") + Range("z27") + Range("z30") + Range("z35") + Range("z39") + Range("z43")
Range("e4") = Range("z4") + Range("z8") + Range("z12") + Range("z16") + Range("z20") + Range("z24") + Range("z28") + Range("z30") + Range("z36") + Range("z40") + Range("z44")
Range("e5") = Range("z5") + Range("z9") + Range("z13") + Range("z17") + Range("z21") + Range("z25") + Range("z29") + Range("z30") + Range("z37") + Range("z41") + Range("z45")


For i = 2 To 5
For j = 2 To 5
If Cells(i, j) = 0 Then
Cells(i, j) = ""
End If
Next
Next

For i = 2 To 60
For j = 23 To 26
Cells(i, j) = ""
Next
Next


Columns("aa:zz").ClearContents
End Sub
'FIN DE CODE

et a fin d'alleger ce code jai cree un autre avec une boucle while mais ca n marche pas

Option Explicit
Public nb_speciality As Integer
Public speciality1 As String
Public speciality2 As String
Public speciality3 As String
Public speciality4 As String
Public speciality5 As String
Public speciality6 As String
Public speciality7 As String
Public speciality8 As String
Public speciality9 As String
Public speciality10 As String
Public speciality11 As String
Public speciality12 As String
Public speciality As String
Public list_speciality() As Variant

'CODE
Sub essai_qpdc()

Dim k, n, i, j As Integer
Dim x As Integer
Dim y As Integer
Dim y1 As Integer
Dim y2 As Integer
Dim y22 As Integer
Dim y3 As Integer





nb_speciality = 11
speciality1 = Worksheets("NEW_VB_config").Range("o2").Value
speciality2 = Worksheets("NEW_VB_config").Range("o3").Value
speciality3 = Worksheets("NEW_VB_config").Range("o4").Value
speciality4 = Worksheets("NEW_VB_config").Range("o5").Value
speciality5 = Worksheets("NEW_VB_config").Range("o6").Value
speciality6 = Worksheets("NEW_VB_config").Range("o7").Value
speciality7 = Worksheets("NEW_VB_config").Range("o8").Value
speciality8 = Worksheets("NEW_VB_config").Range("o9").Value
speciality9 = Worksheets("NEW_VB_config").Range("o10").Value
speciality10 = Worksheets("NEW_VB_config").Range("o11").Value
speciality11 = Worksheets("NEW_VB_config").Range("o12").Value

ReDim list_speciality(nb_speciality - 1)
list_speciality(0) = speciality1
list_speciality(1) = speciality2
list_speciality(2) = speciality3
list_speciality(3) = speciality4
list_speciality(4) = speciality5
list_speciality(5) = speciality6
list_speciality(6) = speciality7
list_speciality(7) = speciality8
list_speciality(8) = speciality9
list_speciality(9) = speciality10
list_speciality(10) = speciality11




k = 0
n = 0
While list_speciality(n) <> ""

speciality = list_speciality(n)
Worksheets(speciality).AutoFilterMode = False
i = 0

While Worksheets(speciality).Range("n2").offset(i, 0).Value <> ""


x = Left(Worksheets(speciality).Range("n2").offset(i, 0).Value, 1)
y = Left(Worksheets(speciality).Range("n2").offset(i, 0).Value, 2)
y1 = Right(y, 1)
y2 = Left(Worksheets(speciality).Range("n2").offset(i, 0).Value, 3)
y22 = Right(y2, 1)
y3 = Right(Worksheets(speciality).Range("n2").offset(i, 0).Value, 1)

    If Worksheets(speciality).Range("a2").offset(i, 0).Value = Range("a1") Then
    For j = 2 To 1000
          If x = 1 Then
             Range("aa" & j).offset(0, k).Value = x
             Range("w2").offset(0, k).Value = Application.sum(Range("aa2:aa10000")).offset(0, k).Value
             ElseIf x = 2 Then
             Range("ab" & j).offset(0, k).Value = x
             Range("w3").offset(0, k).Value = Application.sum(Range("ab2:ab10000")).offset(0, k).Value / 2
             ElseIf x = 3 Then
             Range("ac" & j).offset(0, k).Value = x
             Range("w4").offset(0, k).Value = Application.sum(Range("ac2:ac10000")).offset(0, k).Value / 3
             ElseIf x = 4 Then
             Range("ad" & j).offset(0, k).Value = x
             Range("w5").offset(0, k).Value = Application.sum(Range("ad2:ad10000")).offset(0, k).Value / 4
             End If
            
             If y1 = 1 Then
             Range("ae" & j).offset(0, k).Value = y1
             Range("x2").offset(0, k).Value = Application.sum(Range("ae2:ae10000")).offset(0, k).Value
             ElseIf y1 = 2 Then
             Range("af" & j).offset(0, k).Value = y1
             Range("x3").offset(0, k).Value = Application.sum(Range("af2:af10000")).offset(0, k).Value / 2
             ElseIf y1 = 3 Then
             Range("ag" & j).offset(0, k).Value = y1
             Range("x4").offset(0, k).Value = Application.sum(Range("ag2:ag10000")).offset(0, k).Value / 3
             ElseIf y1 = 4 Then
             Range("ah" & j).offset(0, k).Value = y1
             Range("x5").offset(0, k).Value = Application.sum(Range("ah2:ah10000")).offset(0, k).Value / 4
             End If
            
            
             If y22 = 1 Then
             Range("ai" & j).offset(0, k).Value = y22
             Range("y2").offset(0, k).Value = Application.sum(Range("ai2:ai10000")).offset(0, k).Value
             ElseIf y22 = 2 Then
             Range("aj" & j).offset(0, k).Value = y22
             Range("y3").offset(0, k).Value = Application.sum(Range("aj2:aj10000")).offset(0, k).Value / 2
             ElseIf y22 = 3 Then
             Range("ak" & j).offset(0, k).Value = y22
             Range("y4").offset(0, k).Value = Application.sum(Range("ak2:ak10000")).offset(0, k).Value / 3
             ElseIf y22 = 4 Then
             Range("al" & j).offset(0, k).Value = y22
             Range("y5").offset(0, k).Value = Application.sum(Range("al2:al10000")).offset(0, k).Value / 4
             End If
            
             If y3 = 1 Then
             Range("am" & j).offset(0, k).Value = y3
             Range("z2").offset(0, k).Value = Application.sum(Range("am2:am10000")).offset(0, k).Value
             ElseIf y3 = 2 Then
             Range("an" & j).offset(0, k).Value = y3
             Range("z3").offset(0, k).Value = Application.sum(Range("an2:an10000")).offset(0, k).Value / 2
             ElseIf y3 = 3 Then
             Range("ao" & j).offset(0, k).Value = y3
             Range("z4").offset(0, k).Value = Application.sum(Range("ao2:ao10000")).offset(0, k).Value / 3
             ElseIf y3 = 4 Then
             Range("ap" & j).offset(0, k).Value = y3
             Range("z5").offset(0, k).Value = Application.sum(Range("ap2:ap10000")).offset(0, k).Value / 4
             End If
            
            
            
            
          Next j
          


      k = k + 16
      
    
    End If
    
 
    i = i + 1
Wend

 
n = n + 1
Wend

 

Range("b2") = Range("w2") + Range("w6") + Range("w10") + Range("w14") + Range("w18") + Range("w22") + Range("w26") + Range("w30") + Range("w34") + Range("w38") + Range("w42")
Range("b3") = Range("w3") + Range("w7") + Range("w11") + Range("w15") + Range("w19") + Range("w23") + Range("w27") + Range("w31") + Range("w35") + Range("w39") + Range("w43")
Range("b4") = Range("w4") + Range("w8") + Range("w12") + Range("w16") + Range("w20") + Range("w24") + Range("w28") + Range("w32") + Range("w36") + Range("w40") + Range("w44")
Range("b5") = Range("w5") + Range("w9") + Range("w13") + Range("w17") + Range("w21") + Range("w25") + Range("w29") + Range("w33") + Range("w37") + Range("w41") + Range("w45")


Range("c2") = Range("x2") + Range("x6") + Range("x10") + Range("x14") + Range("x18") + Range("x22") + Range("x26") + Range("x30") + Range("x34") + Range("x38") + Range("x42")
Range("c3") = Range("x3") + Range("x7") + Range("x11") + Range("x15") + Range("x19") + Range("x23") + Range("x27") + Range("x30") + Range("x35") + Range("x39") + Range("x43")
Range("c4") = Range("x4") + Range("x8") + Range("x12") + Range("x16") + Range("x20") + Range("x24") + Range("x28") + Range("x30") + Range("x36") + Range("x40") + Range("x44")
Range("c5") = Range("x5") + Range("x9") + Range("x13") + Range("x17") + Range("x21") + Range("x25") + Range("x29") + Range("x30") + Range("x37") + Range("x41") + Range("x45")

Range("d2") = Range("y2") + Range("y6") + Range("y10") + Range("y14") + Range("y18") + Range("y22") + Range("y26") + Range("y30") + Range("y34") + Range("y38") + Range("y42")
Range("d3") = Range("y3") + Range("y7") + Range("y11") + Range("y15") + Range("y19") + Range("y23") + Range("y27") + Range("y30") + Range("y35") + Range("y39") + Range("y43")
Range("d4") = Range("y4") + Range("y8") + Range("y12") + Range("y16") + Range("y20") + Range("y24") + Range("y28") + Range("y30") + Range("y36") + Range("y40") + Range("y44")
Range("d5") = Range("y5") + Range("y9") + Range("y13") + Range("y17") + Range("y21") + Range("y25") + Range("y29") + Range("y30") + Range("y37") + Range("y41") + Range("y45")

Range("e2") = Range("z2") + Range("z6") + Range("z10") + Range("z14") + Range("z18") + Range("z22") + Range("z26") + Range("z30") + Range("z34") + Range("z38") + Range("z42")
Range("e3") = Range("z3") + Range("z7") + Range("z11") + Range("z15") + Range("z19") + Range("z23") + Range("z27") + Range("z30") + Range("z35") + Range("z39") + Range("z43")
Range("e4") = Range("z4") + Range("z8") + Range("z12") + Range("z16") + Range("z20") + Range("z24") + Range("z28") + Range("z30") + Range("z36") + Range("z40") + Range("z44")
Range("e5") = Range("z5") + Range("z9") + Range("z13") + Range("z17") + Range("z21") + Range("z25") + Range("z29") + Range("z30") + Range("z37") + Range("z41") + Range("z45")








'For i = 2 To 5
'For j = 2 To 5
'If Cells(i, j) = 0 Then
'Cells(i, j) = ""
'End If
'Next
'Next

'For i = 2 To 60
'For j = 23 To 26
'Cells(i, j) = ""
'Next
'Next


Columns("aa:zz").ClearContents
End Sub
'FIN DE CODE

EDIT : Ajout du LANGAGE dans les balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.

Afficher la suite

A voir également:

Alléger le code
Code ascii - Guide
Comment déverrouiller un téléphone quand on a oublié le code - Guide
Code puk bloqué - Guide
Code activation windows 10 - Guide
Code blocks - Télécharger - Langages

4 réponses

Réponse 1 / 4

ThauTheme Messages postés 1442 Date d'inscription Statut Membre Dernière intervention 160

Bonjour Blalaa, bonjour le forum,

Peut-être comme ça :

Sub essai_qpdc()
Dim NW As Worksheet 'déclare la variable NW (onglet NEW_VB_config)
Dim TbO(1 To 11) As Worksheet 'déclare le tableau des 11 variables (Tableau des Onglets)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim x As Byte, y1 As Byte, y22 As Byte, y3 As Byte
Dim y As Variant, y2 As Variant  'je ne sais pas à quoi servent ces variables ?!...

Set NW = Worksheets("NEW_VB_config") 'définit l'onglet NW
For J = 1 To 11 'boucle 1 : sur 11 valeurs de 1 à 11 (11 onglets)
    If NW.Cells(J + 1, "O").Value <> "" Then 'condition 1 : si la cellule ligne J+1, colonne O de l'onglet n'est pas vide
        Set TbO(J) = Worksheets(NW.Cells(J + 1, "O").Value) 'définit l'onglet TbO(J)
        For I = 2 To 10000 'boucle 2 : sur 10000 lignes (pourquoi ne pas utiliser la dernière ligne vide de la colonne N ?!...)
            If TbO(J).Cells(I, "N") <> "" Then 'condition 2 : si la cellule de la boucle en colonne N n'est pas vide
                x = Left(TbO(J).Cells(I, "N"), 1) 'définit la varaible x
                y = Left(TbO(J).Cells(I, "N"), 2) 'définit la varaible y (à quoi sert-elle ?!...)
                y1 = Right(y, 1) 'définit la varaible y1
                y2 = Left(TbO(J).Cells(I, "N"), 3) 'définit la varaible y2(à quoi sert-elle ?!...)
                y22 = Right(y2, 1) 'définit la varaible y22
                y3 = Right(TbO(J).Cells(I, "N" & I), 1) 'définit la varaible y3
                If TbO(J).Cells(I, "A") = Range("A1") Then 'condition 3 : si la cellule ligne I colonne A de l'onglet Tbo(J) est égale à A1 (A1 de quel onglet ?!... Mieux vaut préciser !)
                    COL = x + 26 'définit la colonne COL
                    Cells(I, COL) = x 'renvoie x
                    Cells(x + 1, "W") = Application.Sum(Range(Cells(2, COL), Cells(10000, COL))) / x 'fait la somme des lignes 2 à 10000 de la colonne COL divisée par x
                    COL = y1 + 30 'définit la colonne COL
                    Cells(I, COL) = y1 'renvoie y1
                    Cells(x + 1, "X") = Application.Sum(Range(Cells(2, COL), Cells(10000, COL))) / x 'fait la somme des lignes 2 à 10000 de la colonne COL divisée par x
                    COL = y22 + 34 'définit la colonne COL
                    Cells(I, COL) = y22 'renvoie y22
                    Cells(x + 1, "Y") = Application.Sum(Range(Cells(2, COL), Cells(10000, COL))) / x 'fait la somme des lignes 2 à 10000 de la colonne COL divisée par x
                    COL = y3 + 38 'définit la colonne COL
                    Cells(I, COL) = y3 'renvoie y3
                    Cells(x + 1, "Z") = Application.Sum(Range(Cells(2, COL), Cells(10000, COL))) / x 'fait la somme des lignes 2 à 10000 de la colonne COL divisée par x
                End If 'fin de la condition 3
            End If 'fin de la condition 2
        Next I 'prochaine ligne de la boucle 2
    End If 'fin de la condition 1
Next J 'prochain onglet de la boucle 1
End Sub

À tester...

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

bonjour

merci pour le code, je vais le rester si ca marche

pour repondre a vos questions sur la valeur y et y2

en faite dans mes cellules n jai un cfifre qui contient 4 nombre qui peuvent etre compose de 1 a 4 (exemple 1111, 1234 ,3333 ,4444,4231......) donc je recupere a chque fois le premier nombre apre le 2 apre le 3 apres le 4 eme
exmple dans la cellule n4 = 1234
x=1
y1=2
y22=3
y3=4

voila jespere que jai repondu a votre questions

merci encore

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

je crois que ca marche pas

il maffiche erreur (400)

Réponse 2 / 4

ThauTheme Messages postés 1442 Date d'inscription Statut Membre Dernière intervention 160

Re,

Je t'avoue que je n'ai pas testé, tu penses bien...
Toutefois, je crois que ca marche pas ne veux absolument rien dire. Ou ça marche, ou ça marche pas !... Et si ça marche pas, quelle est la ligne qui plante ?

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

Re

il m'affiche directement me message d'erreur " 400 "

Réponse 3 / 4

ThauTheme Messages postés 1442 Date d'inscription Statut Membre Dernière intervention 160

Re,

Oui d'accord ! Mais quand il t'affiche le message, il ouvre une boîte de dialogue qui te propose l'option Débogage. Clique dessus et tu verras une ligne surlignée de jaune. C'est cette ligne qu'il nous faut pour mieux comprendre.
Sinon, pour éviter de perdre notre temps, je te conseille de proposer le fichier via un hébergeur style : https://www.cjoint.com/

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

bonjour

je viens de mettre le fichier

excusez pour ce retard je vous en remercie

ThauTheme Messages postés 1442 Date d'inscription Statut Membre Dernière intervention 160

Où ça ? il te faut nous donner le lien vers...

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

Re

je mexcuse jai oublie de mettre le lein

https://www.cjoint.com/c/IDklmdqPmE6

davance merci

Réponse 4 / 4

ThauTheme Messages postés 1442 Date d'inscription Statut Membre Dernière intervention 160

Re,

Première constatation : chez moi pas d'erreur !...

Mais :
• Premier problème dans ton code initial avec la condition :

If Worksheets(a).Range("a" & i) = Range("a1") Then

qui avec mon code est devenu :

If TbO(J).Cells(I, "A") = Range("A1") Then

A1 Vaut toujours Projet. Tu aura beau boucler, la condition ne se réalisera jamais...

• Second problème tu utilises, copies, colles ou envoie des valeurs dans des cellules sans en spécifier l'onglet. Ça marche mais cela signifie qu'il s'agit toujours de l'onglet NEW_VB_config.

Sinon, si tu renvoies un fichier, fait l'effort d'y mettre suffisamment de données pour que les tests soient significatifs !...

Si j'ai bien compris voici un code modifié :

Sub essai1_qpdc()
Dim NW As Worksheet 'déclare la variable NW (onglet NEW_VB_config)
Dim TbO() As Worksheet 'déclare la variable TbO (Tableau des Onglets)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim x As Byte, y1 As Byte, y22 As Byte, y3 As Byte
Dim y As Variant, y2 As Variant  'je ne sais pas à quoi servent ces variables ?!...
Dim DLO As Integer 'déclare la variable DLO (Dernière Ligne de la colonne O)
Dim DLN As Integer 'déclare la variable DLN (Dernière Ligne de la colonne N)

Set NW = Worksheets("NEW_VB_config") 'définit l'onglet NW
DLO = NW.Cells(Application.Rows.Count, "O").End(xlUp).Row 'définit la dernière ligne éditée DLO de la colonne O de l'onglet NW
ReDim Preserve TbO(2 To DLO) 'redimensionne le tableau TbO
For J = 2 To DLO 'boucle 1 : sur toutes les ligne J de 2 à DLO
    If NW.Cells(J, "O").Value <> "" Then 'condition 1 : si la cellule ligne J, colonne O de l'onglet n'est pas vide
        Set TbO(J) = Worksheets(NW.Cells(J, "O").Value) 'définit l'onglet TbO(J)
        DLN = TbO(J).Cells(Application.Rows.Count, "N").End(xlUp).Row 'définit la dernière ligne éditée de la colonne N de l'onglet TbO(J)
        'Debug.Print TbO(J).Name, DLN 'pour tests
        For I = 2 To DLN 'boucle 2 : sur toutes les lignes de 2 à DLN
            If TbO(J).Cells(I, "N") <> "" Then 'condition 2 : si la cellule de la boucle en colonne N n'est pas vide
                x = Left(TbO(J).Cells(I, "N"), 1) 'définit la varaible x
                y = Left(TbO(J).Cells(I, "N"), 2) 'définit la varaible y (à quoi sert-elle ?!...)
                y1 = Right(y, 1) 'définit la varaible y1
                y2 = Left(TbO(J).Cells(I, "N"), 3) 'définit la varaible y2(à quoi sert-elle ?!...)
                y22 = Right(y2, 1) 'définit la varaible y22
                y3 = Right(TbO(J).Cells(I, "N"), 1)  'définit la varaible y3
                If TbO(J).Cells(I, "A") = Range("A1") Then 'condition 3 : si la cellule ligne I colonne A de l'onglet Tbo(J) est égale à A1 (A1 de quel onglet ?!... Mieux vaut préciser !)
                    COL = x + 26 'définit la colonne COL
                    TbO(J).Cells(I, COL) = x 'renvoie x
                    TbO(J).Cells(x + 1, "W") = Application.Sum(TbO(J).Range(TbO(J).Cells(2, COL), TbO(J).Cells(10000, COL))) / x 'fait la somme des lignes 2 à 10000 de la colonne COL divisée par x
                    COL = y1 + 30 'définit la colonne COL
                    TbO(J).Cells(I, COL) = y1 'renvoie y1
                    TbO(J).Cells(x + 1, "X") = Application.Sum(TbO(J).Range(TbO(J).Cells(2, COL), TbO(J).Cells(10000, COL))) / x 'fait la somme des lignes 2 à 10000 de la colonne COL divisée par x
                    COL = y22 + 34 'définit la colonne COL
                    TbO(J).Cells(I, COL) = y22 'renvoie y22
                    TbO(J).Cells(x + 1, "Y") = Application.Sum(TbO(J).Range(TbO(J).Cells(2, COL), TbO(J).Cells(10000, COL))) / x 'fait la somme des lignes 2 à 10000 de la colonne COL divisée par x
                    COL = y3 + 38 'définit la colonne COL
                    TbO(J).Cells(I, COL) = y3 'renvoie y3
                    TbO(J).Cells(x + 1, "Z") = Application.Sum(TbO(J).Range(TbO(J).Cells(2, COL), TbO(J).Cells(10000, COL))) / x 'fait la somme des lignes 2 à 10000 de la colonne COL divisée par x
                End If 'fin de la condition 3
            End If 'fin de la condition 2
        Next I 'prochaine ligne de la boucle 2
    End If 'fin de la condition 1
Next J 'prochain onglet de la boucle 1

Range("b2") = Range("w2") + Range("w6") + Range("w10") + Range("w14") + Range("w18") + Range("w22") + Range("w26") + Range("w30") + Range("w34") + Range("w38") + Range("w42")
Range("b3") = Range("w3") + Range("w7") + Range("w11") + Range("w15") + Range("w19") + Range("w23") + Range("w27") + Range("w31") + Range("w35") + Range("w39") + Range("w43")
Range("b4") = Range("w4") + Range("w8") + Range("w12") + Range("w16") + Range("w20") + Range("w24") + Range("w28") + Range("w32") + Range("w36") + Range("w40") + Range("w44")
Range("b5") = Range("w5") + Range("w9") + Range("w13") + Range("w17") + Range("w21") + Range("w25") + Range("w29") + Range("w33") + Range("w37") + Range("w41") + Range("w45")

Range("c2") = Range("x2") + Range("x6") + Range("x10") + Range("x14") + Range("x18") + Range("x22") + Range("x26") + Range("x30") + Range("x34") + Range("x38") + Range("x42")
Range("c3") = Range("x3") + Range("x7") + Range("x11") + Range("x15") + Range("x19") + Range("x23") + Range("x27") + Range("x30") + Range("x35") + Range("x39") + Range("x43")
Range("c4") = Range("x4") + Range("x8") + Range("x12") + Range("x16") + Range("x20") + Range("x24") + Range("x28") + Range("x30") + Range("x36") + Range("x40") + Range("x44")
Range("c5") = Range("x5") + Range("x9") + Range("x13") + Range("x17") + Range("x21") + Range("x25") + Range("x29") + Range("x30") + Range("x37") + Range("x41") + Range("x45")

Range("d2") = Range("y2") + Range("y6") + Range("y10") + Range("y14") + Range("y18") + Range("y22") + Range("y26") + Range("y30") + Range("y34") + Range("y38") + Range("y42")
Range("d3") = Range("y3") + Range("y7") + Range("y11") + Range("y15") + Range("y19") + Range("y23") + Range("y27") + Range("y30") + Range("y35") + Range("y39") + Range("y43")
Range("d4") = Range("y4") + Range("y8") + Range("y12") + Range("y16") + Range("y20") + Range("y24") + Range("y28") + Range("y30") + Range("y36") + Range("y40") + Range("y44")
Range("d5") = Range("y5") + Range("y9") + Range("y13") + Range("y17") + Range("y21") + Range("y25") + Range("y29") + Range("y30") + Range("y37") + Range("y41") + Range("y45")

Range("e2") = Range("z2") + Range("z6") + Range("z10") + Range("z14") + Range("z18") + Range("z22") + Range("z26") + Range("z30") + Range("z34") + Range("z38") + Range("z42")
Range("e3") = Range("z3") + Range("z7") + Range("z11") + Range("z15") + Range("z19") + Range("z23") + Range("z27") + Range("z30") + Range("z35") + Range("z39") + Range("z43")
Range("e4") = Range("z4") + Range("z8") + Range("z12") + Range("z16") + Range("z20") + Range("z24") + Range("z28") + Range("z30") + Range("z36") + Range("z40") + Range("z44")
Range("e5") = Range("z5") + Range("z9") + Range("z13") + Range("z17") + Range("z21") + Range("z25") + Range("z29") + Range("z30") + Range("z37") + Range("z41") + Range("z45")

End Sub

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

Bonjour

je vous remercie pour ts ce temps que vous avez consacre pour mon programme

je vais le tester

merci encore

Discussions similaires

sertissage des cables rj45

Comment rentrer le nouveau code activation pour avoir acres aux chaînes

Votre réponse

Discussions similaires