Problème de macro pour un traitement de données horizontal puis vertical

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

Ma question va surement paraître toute simple pour les initiés, mais débutant sur VBA je sèche...!

J'essaye de faire un simulateur d'annuités sur 10 ans et sur mon fichier source (provenant d'un logiciel métier), je dois respecter une procédure bien définie.

J'ai donc plusieurs lignes avec pour chaques lignes plusieurs prêts (profil, date, montant), j'essaye donc de récupérer chaque prêt du tableau pour les recopier dans un autre tableau dans l'ordre suivant: 1 boucle pour une recherche verticale et 1 boucle pour une recherche horizontale, puis je reviens à la ligne et je recommence.

Ma boucle pour la recherche horizontale marche sans problème mais je n'arrive pas à redéfinir "profilsource" en "O3"

ma macro se présente comme ceci (ce qui est souligné est ce qui pose problème):
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 Set profilsource = Worksheets("Opérations réhab").Range("O2") Set annuitéprojections = Worksheets("Projection annuités").Range("C2") Set testprofilsource = Worksheets("Opérations réhab").Range("O2") Do While testprofilsource <> "" Do While profilsource <> "" profilcalculs.FormulaR1C1 = profilsource.Value datecalculs.FormulaR1C1 = profilsource.Offset(0, 1).Value montantcalculs.FormulaR1C1 = profilsource.Offset(0, 2).Value With annuitéprojections .Offset(1, 0).EntireRow.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove .FormulaR1C1 = annuitécalculs.Value .Offset(0, 1).FormulaR1C1 = annuitécalculs.Offset(0, 1).Value .Offset(0, 2).FormulaR1C1 = annuitécalculs.Offset(0, 2).Value .Offset(0, 3).FormulaR1C1 = annuitécalculs.Offset(0, 3).Value .Offset(0, 4).FormulaR1C1 = annuitécalculs.Offset(0, 4).Value .Offset(0, 5).FormulaR1C1 = annuitécalculs.Offset(0, 5).Value .Offset(0, 6).FormulaR1C1 = annuitécalculs.Offset(0, 6).Value .Offset(0, 7).FormulaR1C1 = annuitécalculs.Offset(0, 7).Value .Offset(0, 8).FormulaR1C1 = annuitécalculs.Offset(0, 8).Value .Offset(0, 9).FormulaR1C1 = annuitécalculs.Offset(0, 9).Value End With Set profilsource = profilsource.Offset(0, 3) Set annuitéprojections = annuitéprojections.Offset(1, 0) Loop Set testprofilsource = testprofilsource.Offset(1, 0) Set testprofilsource = profilsource Loop
Je vous remercie d'avance pour votre aide :)

Voici le fichier de test

16/12/2014, 14h12
eric4459

Bonjour,
Pourquoi définissez-vous la même cellule avec un nom différent?

Code:

Set profilsource = Worksheets("Opérations réhab").Range("O2")

Code:

Set testprofilsource = Worksheets("Opérations réhab").Range("O2")

Je ne suis pas expert mais selon moi votre problème vient surement de là...

Eric
16/12/2014, 14h32
minh86

Bonjour,

Merci pour votre réponse.

J'ai effectivement défini testprofilsource en "O2" car en essayant de faire "set testprofilsource = profilsource" cela ne marchait pas non plus.

J'ai utilisé testprofilsource pour faire uniquement un déplacement vertical (O3, 04, etc...) et ramener profilsource au même endroit que testprofilsource pour recommencer la 2eme boucle. Mais à priori cela ne marche pas...

Minh86
Peut-être en essayant ceci

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
Dim profilsource as ???
Dim testprofilsource as ???

Set annuitéprojections = Worksheets("Projection annuités").Range("C2")
Set testprofilsource = Worksheets("Opérations réhab").Range("O2")
profilsource=testprofilsource
Do While testprofilsource <> ""   Do While profilsource <> ""

    profilcalculs.FormulaR1C1 = profilsource.Value
    datecalculs.FormulaR1C1 = profilsource.Offset(0, 1).Value
    montantcalculs.FormulaR1C1 = profilsource.Offset(0, 2).Value
    
    With annuitéprojections
    .Offset(1, 0).EntireRow.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
    .FormulaR1C1 = annuitécalculs.Value
    .Offset(0, 1).FormulaR1C1 = annuitécalculs.Offset(0, 1).Value
    .Offset(0, 2).FormulaR1C1 = annuitécalculs.Offset(0, 2).Value
    .Offset(0, 3).FormulaR1C1 = annuitécalculs.Offset(0, 3).Value
    .Offset(0, 4).FormulaR1C1 = annuitécalculs.Offset(0, 4).Value
    .Offset(0, 5).FormulaR1C1 = annuitécalculs.Offset(0, 5).Value
    .Offset(0, 6).FormulaR1C1 = annuitécalculs.Offset(0, 6).Value
    .Offset(0, 7).FormulaR1C1 = annuitécalculs.Offset(0, 7).Value
    .Offset(0, 8).FormulaR1C1 = annuitécalculs.Offset(0, 8).Value
    .Offset(0, 9).FormulaR1C1 = annuitécalculs.Offset(0, 9).Value
    End With
    
    Set profilsource = profilsource.Offset(0, 3)
    Set annuitéprojections = annuitéprojections.Offset(1, 0)

    Loop

Set testprofilsource = testprofilsource.Offset(1, 0)
Set testprofilsource = profilsource

Loop

Eric

Bonjour Eric4459, j'ai essayé mais cela ne change rien. Ce qui est bizarre c'est que la 2eme boucle fait bien son travail (do while profilsource <>"") mais dès que je met la 1ere boucle plus rien ne se passe...

la macro complète se présente comme ça:

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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Dim réhab As Worksheet
Dim neuf As Worksheet
Dim projections As Worksheet
Dim calculs As Worksheet
Dim montantcalculs As Range
Dim profilsource As Range
Dim profilcalculs As Range
Dim datecalculs As Range
Dim annuitécalculs As Range
Dim annuitéprojections As Range
 
Sub Calcul_nouvelles_annuités()
 
Set réhab = Worksheets("Opérations réhab")
Set neuf = Worksheets("Opérations neuves")
Set calculs = Worksheets("Calcul annuités")
Set projections = Worksheets("Projection annuités")
Set profilcalculs = Worksheets("Calcul annuités").Range("B1")
Set datecalculs = Worksheets("Calcul annuités").Range("B2")
Set montantcalculs = Worksheets("Calcul annuités").Range("B3")
Set annuitécalculs = Worksheets("Calcul annuités").Range("F9")
 
Set profilsource = Worksheets("Opérations réhab").Range("O2")
Set annuitéprojections = Worksheets("Projection annuités").Range("C2")
profilsource = testprofilsource
 
Do While testprofilsource <> ""
 
    Do While profilsource <> ""
 
    profilcalculs.FormulaR1C1 = profilsource.Value
    datecalculs.FormulaR1C1 = profilsource.Offset(0, 1).Value
    montantcalculs.FormulaR1C1 = profilsource.Offset(0, 2).Value
 
    With annuitéprojections
    .Offset(1, 0).EntireRow.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
    .FormulaR1C1 = annuitécalculs.Value
    .Offset(0, 1).FormulaR1C1 = annuitécalculs.Offset(0, 1).Value
    .Offset(0, 2).FormulaR1C1 = annuitécalculs.Offset(0, 2).Value
    .Offset(0, 3).FormulaR1C1 = annuitécalculs.Offset(0, 3).Value
    .Offset(0, 4).FormulaR1C1 = annuitécalculs.Offset(0, 4).Value
    .Offset(0, 5).FormulaR1C1 = annuitécalculs.Offset(0, 5).Value
    .Offset(0, 6).FormulaR1C1 = annuitécalculs.Offset(0, 6).Value
    .Offset(0, 7).FormulaR1C1 = annuitécalculs.Offset(0, 7).Value
    .Offset(0, 8).FormulaR1C1 = annuitécalculs.Offset(0, 8).Value
    .Offset(0, 9).FormulaR1C1 = annuitécalculs.Offset(0, 9).Value
    .Offset(0, 10).FormulaR1C1 = annuitécalculs.Offset(0, 10).Value
    End With
 
    Set profilsource = profilsource.Offset(0, 3)
    Set annuitéprojections = annuitéprojections.Offset(1, 0)
 
    Loop
 
Set testprofilsource = testprofilsource.Offset(1, 0)
Set testprofilsource = profilsource
 
Loop
 
End Sub[/U]