Double boucle VBA

Version imprimable

Double boucle VBA

Bonjour à tous et à toutes,

Débutant en VBA je tente de réaliser une double boucle.
En effet au départ j’ai construis la macroC1 avec la variable « C » qui me copie les résultats en I et J sur laquelle je veux inclure une 2° boucle (exemple variable D en lieu et place de R3C82) qui devrait me copier les résultats en K et L puis en M et N pour une évolution de D de 25 à 27.
Après plusieurs essais, j’arrive à définir la variable D, lui faire faire la double boucle, par contre je viens systématiquement écraser les résultats précédents car je ne connais pas l’instruction permettant de copier sur les colonnes voisines. C’est pour cela que j’ai recours à plusieurs macros pour compenser mes lacunes. Si quelqu’un pouvait m’orienter ce serait le TOP.

Merci par avance.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 Sub MacroC1() Dim C& Dim Deb As Currency Application.ScreenUpdating = False Deb = Timer With Sheets("C-Test") For C = 1 To 58 Range("CF26").FormulaR1C1 = "=IF(AND(RC[-3]>" & C & ",RC[-3]<R3C82,RC[-65]=1),1,IF(AND(RC[-3]>" & C & ",RC[-3]<R3C82,RC[-65]=0),0,2))" Range("CF26").AutoFill Destination:=Range("CF26:CF1657"), Type:=xlFillDefault .Range("CF1").FormulaR1C1 = "=100*R4C84/(R3C84+R4C84)" .Range("CI1").Offset(C, 0).Value = .Range("CF1").Value .Range("CF2").FormulaR1C1 = "=(R3C84+R4C84)" .Range("CJ1").Offset(C, 0).Value = .Range("CF2").Value Next C End With MacroC2 ActiveWorkbook.Save Range("CD1") = (Timer - Deb) & " sec" Application.ScreenUpdating = True End Sub Sub MacroC2() Dim C& Dim Deb As Currency With Sheets("C-Test") For C = 1 To 58 Range("CF26").FormulaR1C1 = "=IF(AND(RC[-3]>" & C & ",RC[-3]<R3C82,RC[-65]=1),1,IF(AND(RC[-3]>" & C & ",RC[-3]<R3C82,RC[-65]=0),0,2))" Range("CF26").AutoFill Destination:=Range("CF26:CF1657"), Type:=xlFillDefault .Range("CF1").FormulaR1C1 = "=100*R4C84/(R3C84+R4C84)" .Range("CK1").Offset(C, 0).Value = .Range("CF1").Value .Range("CF2").FormulaR1C1 = "=(R3C84+R4C84)" .Range("CL1").Offset(C, 0).Value = .Range("CF2").Value Next C End With End Sub

06/06/2011, 11h37
mercatog
Bonjour

Pour remplacer l'Autofill tu peux écrire directement ta formule comme ceci:
Code:

1 2 For C = 1 To 58 .Range("CF26:CF1657").FormulaR1C1 = "=IF(AND(RC[-3]>" & C & ",RC[-3]<R3C82,RC[-65]=1),1,IF(AND(RC[-3]>" & C & ",RC[-3]<R3C82,RC[-65]=0),0,2))"
Mais:

Ce que tu essaies de faire ici c'est écrire et écraser une formule 58 fois pour avoir enfin de compte en CF26

Code:

=SI(ET(CC26>58;CC26<$CD$3;S26=1);1;SI(ET(CC26>58;CC26<$CD$3;S26=0);0;2))

Explique ce que tu souhaite faire.

Bonjour mercatog et Merci pour l’instruction.

Je vais donc passer étape par étape.
Pour C=1 et D=25
En CF26 il y a = SI(ET(CC26>1;CC26<25;S26=1);1;SI(ET(CC26>1;CC26<25;S26=0);0;2))
En CF27 il y a = SI(ET(CC27>1;CC27<25;S27=1);1;SI(ET(CC27>1;CC27<25;S27=0);0;2))
Etc jusqu’en CF1657
En CF1 le résultat en % de CF3 et CF4 (CF3= NB.SI(CF26:CF1657;0) et CF4= NB.SI(CF26:CF1657;1), formule Excel) copié en CI1
En CF2 la somme de CF3 et CF4 copié en CJ1

Idem pour C=2 et D=25 mais copié en CI2 et CJ2
jusqu'a C=58 et D=25 et copié en CI58 et CJ58

Cette partie ne me pose pas de problème, par contre lorsque la valeur de D passe a 26, j’écrase les résultats de CI1 et CJ1 parce que je n’arrive pas à lui faire écrire les résultats en CK1 et CL1. J’ai donc besoin de l’instruction qui lui dise soit de copier les nouveaux résultats dans la colonne vide suivante en fonction de l’incrémentation de D.
Je joins le bout de code qui ne marche pas.

Merci par avance
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Sub MacroC1() Dim C&, D& Dim Deb As Currency Application.ScreenUpdating = False Deb = Timer With Sheets("C-Test") For D = 25 To 27 For C = 1 To 58 .Range("CF26:CF1657").FormulaR1C1 = "=IF(AND(RC[-3]>" & C & ",RC[-3]<" & D & ",RC[-65]=1),1,IF(AND(RC[-3]>" & C & ",RC[-3]<" & D & ",RC[-65]=0),0,2))" .Range("CF1").FormulaR1C1 = "=100*R4C84/(R3C84+R4C84)" .Range("CI1").Offset(C, 0).Value = .Range("CF1").Value .Range("CF2").FormulaR1C1 = "=(R3C84+R4C84)" .Range("CJ1").Offset(C, 0).Value = .Range("CF2").Value Next C Next D End With 'MacroC2 ActiveWorkbook.Save Range("CD1") = (Timer - Deb) & " sec" Application.ScreenUpdating = True End Sub

07/06/2011, 10h27
el_slapper

J'avais séché hier.

En fait, le souci est sur tes offset : tu pars toujours de la même case, et tu fais un offset (C,0). Alors forcément, ça décale dans un sens, mais pas dans l'autre. Il te faut un offset (C,D), pour prendre en compte l'incrémentation de ton autre boucle.

Sauf que ta boucle D ne va pas, parcequ'elle passe à 25, 26, et 27, alors qu'il te faut des décalages de 0, 2 et 4. Tu dois donc créer une nouvelle variable, par exemple Dpos, que tu pourrais calculer juste après la boucle en Dvar = ((D - 25) * 2), et tu remplaces tes offset (C,0) par offset (C,Dvar).

Attention : non testé, j'ai pu me gourrer dans les chiffres. Mais ça devrait marcher, avec sans doute des ajustements.

Bonjour et Un grand merci el slapper,

J’ai suivi tes instructions et j’y suis arrivé. Une astuce aussi simple il fallait y penser.
Je joins ce que j’ai réalisé.

Très cordialement

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub MacroCD()
Dim C&, D&, E&
Dim Deb As Currency
 Application.ScreenUpdating = False
Deb = Timer
With Sheets("C-Test")
 
For D = 25 To 27
E = ((D - 25) * 2)
 
     For C = 1 To 58
 
    .Range("CF26:CF1657").FormulaR1C1 = "=IF(AND(RC[-3]>" & C & ",RC[-3]<" & D & ",RC[-65]=1),1,IF(AND(RC[-3]>" & C & ",RC[-3]<" & D & ",RC[-65]=0),0,2))"
 
        .Range("CF1").FormulaR1C1 = "=100*R4C84/(R3C84+R4C84)"
        .Range("CI1").Offset(C, E).Value = .Range("CF1").Value
 
            .Range("CF2").FormulaR1C1 = "=(R3C84+R4C84)"
            .Range("CJ1").Offset(C, E).Value = .Range("CF2").Value
 
     Next C
Next D
End With
  ActiveWorkbook.Save
  Range("CD1") = (Timer - Deb) & " sec"
  Application.ScreenUpdating = True
End Sub