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

**minh86** · 15/12/2014, 21h03

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**eric4459** · 16/12/2014, 14h12

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**minh86** · 16/12/2014, 14h32

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

**eric4459** · 16/12/2014, 16h32

Minh86
Peut-être en essayant ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**minh86** · 16/12/2014, 17h04

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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]

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

Macros et VBA Excel

Discussions similaires

Partager

Partager