Correction d’un apprenti en VBA

**pascal4782** · 27/04/2011, 20h15

Bonjour à tous,

J’ai besoin que quelqu’un me corrige mon code, en effet je suis en apprentissage et j’aimerai progresser. De plus le temps de travail est de 500 s pour ce petit fichier, je pense que j’ai écris quelques maladresse qui ralentisse le travail.
Pour améliorer la procédure j’ai passé plusieurs heures sur les tutos de SilkyRoad et Didier Gonard concernant les variables tableaux, et j’avoue que si les exemples sont bien faits, par contre je n’arrive pas à l’appliquer sur ma procédure. Je pense qu’il me faudrait plus d’exemple avec des boucles pour comprendre le fonctionnement.

Merci par avance

Cordialement

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
Sub TestABCDE()
 
Deb = Timer
   Application.ScreenUpdating = False
'definition des variables
   Dim shtFrom As Worksheet, shtTo As Worksheet
   Dim A As Long, B As Long, X As Integer, Str_Val_1 As String, Str_Val_2 As String, Cel As Range
'initialisation du tableau
     Sheets("A").Range("a20:c79").ClearContents
' I = NB DE COLONNES A RAPATRIER
       For i = 1 To 150
        decal = 1 * i
 'copie successive des colonnes du tableau Z vers la colonne A20
  Set shtTo = Worksheets("A")
     Set shtFrom = Worksheets("A")
        shtTo.Range("A20:A79").Value = shtFrom.Range("L20:L79").Offset(0, decal).Value
           For X = 1 To 1
    Select Case X
        Case 1
            Str_Val_1 = "=RC[-1]+sin(RC[-2]/R"
            Set Cel = Range("F1")
    End Select
' la formule est bouclée sur la totalité des valeurs de 20 à 59: A = Nb de N° a tester
      For A = 20 To 360
        Range("C20").FormulaR1C1 = Str_Val_1 & A & "C7)"
           Range("C20").AutoFill Destination:=Range("C20:C79"), Type:=xlFillDefault
'le résultat du test est copié dans la cellule en face de la valeur A
     Range("C12").Copy
          Cel.Offset(A - 1, 0).PasteSpecial Paste:=xlPasteValues
' recalcul des données en fonction de la valeur max tableau
    Str_Val_2 = "=RC[-1]+sin(RC[-2]/R"
        Set Cel = Range("F1")
              For B = 17 To 17
    Range("C20").FormulaR1C1 = Str_Val_1 & B & "C6)"
      Range("C20").AutoFill Destination:=Range("C20:C79"), Type:=xlFillDefault
        Next B
    Next A
Next X
'copie des résultats (en J pour controler l'augmentation des resultats, en I pour la valeur max)
   shtTo.Range("I1").Offset(i - 1, 0).Value = shtFrom.Range("F17").Value
      shtTo.Range("J1").Offset(i - 1, 0).Value = shtFrom.Range("F18").Value
         shtTo.Range("b20:b79").Value = shtFrom.Range("c20:c79").Value
Next i
   Application.ScreenUpdating = True
 MsgBox "J'ai bossé " & Timer - Deb & " seconde"
End Sub

**casefayere** · 27/04/2011, 22h37

Bonsoir,

Je me suis arrété en plein code qui me parait illogique, j'irai plus loin quand tu auras répondu aux remarques que j'ai faites dans cette partie :

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
Sub TestABCDE()
 
Deb = Timer
Application.ScreenUpdating = False
'definition des variables
Dim shtFrom As Worksheet, shtTo As Worksheet
Dim A As Long, B As Long, X As Integer, Str_Val_1 As String, Str_Val_2 As String, Cel As Range
'initialisation du tableau
Sheets("A").Range("a20:c79").ClearContents
' I = NB DE COLONNES A RAPATRIER
For i = 1 To 150
   decal = 1 * i 'donc decal = i donc inutile
   Set shtTo = Worksheets("A")
   Set shtFrom = Worksheets("A") 'pourquoi 2 variables pour même feuille ?
   shtTo.Range("A20:A79").Value = shtFrom.Range("L20:L79").Offset(0, i).Value
   For X = 1 To 1 'inutile
   Select Case X 'inutile
      Case 1 'inutile
         Str_Val_1 = "=RC[-1]+sin(RC[-2]/R"
         Set Cel = Range("F1")
   End Select'inutile
......

**el_slapper** · 28/04/2011, 10h35

un autre point qui semble excessif :

Code :

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

1
2
3
4
For B = 17 To 17
     Range("C20").FormulaR1C1 = Str_Val_1 & B & "C6)"
     Range("C20").AutoFill Destination:=Range("C20:C79"), Type:=xlFillDefault
Next B

exactement équivalent à

Code :

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

1
2
Range("C20").FormulaR1C1 = Str_Val_1 & "17C6)"
Range("C20").AutoFill Destination:=Range("C20:C79"), Type:=xlFillDefault

En outre, tes indentations me semblent mauvaises. J'espère que dans ton code tu as bien ton

Code :

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

For A = 20 To 360

qui commence exactement dans la même colonne que le

Code :

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

Next A

correspondant. Si ça n'est pas le cas, je te conseille de bien aligner les terminateurs avec les commençeurs.

**pascal4782** · 28/04/2011, 19h21

Bonjour,

Merci pour avoir regardé mon petit bout d’essai
J’ai modifié en fonction des remarques de casefayere et el slapper
Le code semble plus léger maintenant, je suis prés pour la suite des remarques

Merci

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
 Sub TestABCDE()
 
Deb = Timer
   'Application.ScreenUpdating = False
'definition des variables
   Dim shtFrom As Worksheet, shtTo As Worksheet
   Dim A As Long, B As Long, X As Integer, Str_Val_1 As String, Str_Val_2 As String, Cel As Range
'initialisation du tableau
     Sheets("A").Range("a20:c79").ClearContents
 ' i = NB DE COLONNES A RAPATRIER
       For i = 1 To 50 ' compte le nombre de colonne a rapatrier
        decal = 1 * i 'si absence de cette ligne, alors la colonne n'est pas copiée
 'copie successive des colonnes du tableau Z vers la colonne A20
  Set shtTo = Worksheets("A")
     Set shtFrom = Worksheets("A")
        shtTo.Range("A20:A79").Value = shtFrom.Range("L20:L79").Offset(0, decal).Value
                    '          For X = 1 To 1 merci le code fonctionne tres bien sans X
                    '   Select Case X
                    '      Case 1
            Str_Val_1 = "=RC[-1]+sin(RC[-2]/R"
            Set Cel = Range("F1")
                        '   End Select
' la formule est bouclée sur la totalité des valeurs de 20 à 100: A = Nb de N° a tester
      For A = 20 To 100
        Range("C20").FormulaR1C1 = Str_Val_1 & A & "C7)"
           Range("C20").AutoFill Destination:=Range("C20:C79"), Type:=xlFillDefault
'le résultat du test est copié dans la cellule en face de la valeur A
     Range("C12").Copy
          Cel.Offset(A - 1, 0).PasteSpecial Paste:=xlPasteValues
' recalcul des données en fonction de la valeur max tableau
    Str_Val_2 = "=RC[-1]+sin(RC[-2]/R"
        Set Cel = Range("F1")
Range("C20").FormulaR1C1 = Str_Val_1 & "17C6)"
Range("C20").AutoFill Destination:=Range("C20:C79"), Type:=xlFillDefault
                  '  For B = 17 To 17
                   ' Range("C20").FormulaR1C1 = Str_Val_1 & B & "C6)"
                  ' Range("C20").AutoFill Destination:=Range("C20:C79"), Type:=xlFillDefault
                  '  Next B
       Next A
                   'Next X
'copie des résultats (en J pour controler l'augmentation des resultats, en I pour la valeur max)
   shtTo.Range("I1").Offset(i - 1, 0).Value = shtFrom.Range("F17").Value
      shtTo.Range("J1").Offset(i - 1, 0).Value = shtFrom.Range("F18").Value
         shtTo.Range("b20:b79").Value = shtFrom.Range("c20:c79").Value
Next i
  ' Application.ScreenUpdating = True
 MsgBox "J'ai bossé " & Timer - Deb & " seconde"
End Sub

**el_slapper** · 29/04/2011, 10h24

Il me semble que certains offsets sont en trop.

En particulier, quand tu as un offset sur une case statique(qui a ses coordonnées en dur dans le programme), il ne sert à rien :

Code :

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

shtTo.Range("I1").Offset(i - 1, 0)

c'est pareil que

Code :

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

shtTo.Range("H1")

Et tu en as d'autres.

Tu as aussi le

Code :

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

1
2
3
4
      For i = 1 To 50 ' compte le nombre de colonne a rapatrier
        decal = 1 * i 'si absence de cette ligne, alors la colonne n'est pas copiée
(.../...)
Next i

comme tu ne te sers pas de i ailleurs, autant faire directement

Code :

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

1
2
3
For decal = 1 To 50
(.../...)
next decal

en faisant sauter la ligne de calcul de decal.

Et sinon, pourquoi tu as mis en commentaires les screenupdating? Ils me semblent, eux, parfaitement utiles. Et j'en oublie sans doute encore pas mal.

**pascal4782** · 29/04/2011, 11h38

Bonjour el slapper,

Merci pour les remarques et commentaires.
J’ai testé, et je constate que toutes les copies sont en H1 et non pas en descendant en fonction du décal. Ou alors je ne comprends pas.

Code :

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

 shtTo.Range("H1").Value = shtFrom.Range("F17").Value

La remarque concernant le decal est pris en compte et le code est modifié en conséquence.
Le screenupdating est involontairement mis en commentaire.

Un grand merci par avance pour la suite.

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
 Sub TestABCDE()
 
Deb = Timer
   Application.ScreenUpdating = False
'definition des variables
   Dim shtFrom As Worksheet, shtTo As Worksheet
   Dim A As Long, Str_Val_1 As String, Str_Val_2 As String, Cel As Range
'initialisation du tableau
     Sheets("A").Range("a20:c79").ClearContents
 
      For decal = 1 To 50
 
 'copie successive des colonnes du tableau Z vers la colonne A20
  Set shtTo = Worksheets("A")
     Set shtFrom = Worksheets("A")
        shtTo.Range("A20:A79").Value = shtFrom.Range("L20:L79").Offset(0, decal).Value
 
            Str_Val_1 = "=RC[-1]+sin(RC[-2]/R"
            Set Cel = Range("F1")
 
' la formule est bouclée sur la totalité des valeurs de 20 à 100: A = Nb de N° a tester
      For A = 20 To 100
        Range("C20").FormulaR1C1 = Str_Val_1 & A & "C7)"
           Range("C20").AutoFill Destination:=Range("C20:C79"), Type:=xlFillDefault
 
'le résultat du test est copié dans la cellule en face de la valeur A
     Range("C12").Copy
          Cel.Offset(A - 1, 0).PasteSpecial Paste:=xlPasteValues
 
' recalcul des données en fonction de la valeur max tableau
    Str_Val_2 = "=RC[-1]+sin(RC[-2]/R"
        Set Cel = Range("F1")
 
Range("C20").FormulaR1C1 = Str_Val_1 & "17C6)"
Range("C20").AutoFill Destination:=Range("C20:C79"), Type:=xlFillDefault
 
       Next A
 
               'copie des résultats (en J pour controler l'augmentation des resultats, en I pour la valeur max)
     shtTo.Range("I1").Offset(decal - 1, 0).Value = shtFrom.Range("F17").Value
      shtTo.Range("J1").Offset(decal - 1, 0).Value = shtFrom.Range("F18").Value
 
         shtTo.Range("b20:b79").Value = shtFrom.Range("c20:c79").Value
 
Next decal
   Application.ScreenUpdating = True
 MsgBox "J'ai bossé " & Timer - Deb & " seconde"
End Sub

**AlainTech** · 30/04/2011, 17h22

Envoyé par el_slapper

Il me semble que certains offsets sont en trop.

En particulier, quand tu as un offset sur une case statique(qui a ses coordonnées en dur dans le programme), il ne sert à rien :

Code :

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

shtTo.Range("I1").Offset(i - 1, 0)

c'est pareil que

Code :

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

shtTo.Range("H1")

Attention aux conseils donnés...
A chaque valeur de i, l'offset fera descendre d'une ligne.

**pascal4782** · 01/05/2011, 08h55

Bonjour et bonne fête à tous,

Un grand merci pour les conseils. Le code a probablement trouvé une certaine logique grâce a vous, mais reste toujours aussi lent, il doit encore rester quelques maladresses
Apres plusieurs essais, je me retrouve avec ce nouveau code.

Cordialement.

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
Sub TestB1()
Deb = Timer
   Application.ScreenUpdating = False
'Definition des variables
   Dim shtFrom As Worksheet, shtTo As Worksheet
   Dim A As Long, Str_Val_1 As String, Cel As Range
'Initialisation du tableau
     Sheets("A").Range("A20:C3379").ClearContents
        For decal = 1 To 690
 'Copie successive des colonnes du tableau vers la colonne A20
  Set shtTo = Worksheets("A")
     Set shtFrom = Worksheets("A")
        shtTo.Range("A20:A3379").Value = shtFrom.Range("AD20:AD3379").Offset(0, decal).Value
            Str_Val_1 = "=RC[-1]+sin(RC[-2]/R"
                Set Cel = Range("F1")
' La formule est bouclée sur la totalité des valeurs selectionnées
      For A = 20 To 469
        Range("C20").FormulaR1C1 = Str_Val_1 & A & "C7)"
           Range("C20").AutoFill Destination:=Range("C20:C3379"), Type:=xlFillDefault
'Le résultat du test est copié dans la cellule en face de la valeur A
     Range("C12").Copy
          Cel.Offset(A - 1, 0).PasteSpecial Paste:=xlPasteValues
'Recalcul des données en fonction de la valeur max tableau
     Range("C20").FormulaR1C1 = Str_Val_1 & "17C6)"
         Range("C20").AutoFill Destination:=Range("C20:C3379"), Type:=xlFillDefault
       Next A
'Copie pour controler l'augmentation des resultats et incrémenter le test
     shtTo.Range("I1").Offset(decal - 1, 0).Value = shtFrom.Range("F17").Value
         shtTo.Range("B20:B3379").Value = shtFrom.Range("C20:C3379").Value
             shtTo.Range("T20:T3379").Value = shtFrom.Range("C20:C3379").Value
      Next decal
          ActiveWorkbook.Save
              Application.ScreenUpdating = True
                  MsgBox "J'ai bossé " & Timer - Deb & " seconde"
End Sub

**Theze** · 01/05/2011, 10h18

Bonjour Pascal et bonjour à toutes et tous,

J'ai un peu modifié ton dernier code mais je n'ai rien testé. Essai et dis moi si il y a une ammélioration. A mon avis, se sont tes copies de plages successives et l'insersion des formules qui prennent du temps, dans ce cas, je me demande si tu ne devrais pas te tourner vers des tableaux pour effectuer tous tes calculs et ensuite coller les résultats obtenus dans un range ? Enfin, c'est mon avis mais il te faudrais revoir tout ton code :

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
61
62
63
 
Sub TestB1()
 
    Dim Fe As Worksheet
    Dim PlgTo As Range
    Dim PlgFrom As Range
    Dim A As Long
    Dim Str_Val_1 As String
    Dim Deb As Long
 
    Deb = Timer
 
    Application.ScreenUpdating = False
 
    Set Fe = Worksheets("A")
 
    With Fe
 
        Set PlgTo = .[A20:A3379]
        Set PlgFrom = .[AD20:AD3379]
 
        PlgTo.ClearContents
 
        'le début de la formule étant le même, il ne sert à rien de la
        'reconstruire 690 fois
        Str_Val_1 = "=RC[-1]+sin(RC[-2]/R"
 
        For decal = 1 To 690
 
            'Copie successive des colonnes du tableau vers la colonne A20
            PlgTo = PlgFrom.Offset(0, decal).Value
 
            'La formule est bouclée sur la totalité des valeurs selectionnées
            For A = 20 To 469
 
                .[C20].FormulaR1C1 = Str_Val_1 & A & "C7)"
                .[C20].AutoFill .[C20:C3379]
 
                'Le résultat du test est copié dans la cellule en face de la valeur A
                .[C12].Copy .Range("F" & A - 1)
 
                'Recalcul des données en fonction de la valeur max tableau
                .[C20].FormulaR1C1 = Str_Val_1 & "17C6)"
                .[C20].AutoFill .[C20:C3379]
 
            Next A
 
            'Copie pour controler l'augmentation des resultats et incrémenter le test
            .[I1].Offset(decal - 1, 0).Value = .[F17].Value
 
            .[B20:B3379] = .[C20:C3379]
            .[T20:T3379] = .[C20:C3379]
 
        Next decal
 
    End With
 
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
 
    MsgBox "J'ai bossé " & Timer - Deb & " seconde"
 
End Sub

Hervé.

**pascal4782** · 01/05/2011, 12h08

Bonjour et merci pour la proposition,

J’ai essayé de « bidouiller » le code pour le faire fonctionner, mais je n’ai pas le niveau pour le faire. J’ai ajouté qqes commentaires mais je pense, comme vous le suggérez, je vais me tourner vers les variables tableaux.
J’ai sortie les tutos « Conceptualisation des variables tableaux, Utiliser les variables tableaux et programmer efficacement VB-VBA » pour essayer de comprendre la programmation.
Je clos le post et reviendrais par la suite si je bloque. Un grand merci à vous tous.

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
61
62
63
64
65
Sub TestB21()
 
    Dim Fe As Worksheet
    Dim PlgTo As Range
    Dim PlgFrom As Range
    Dim A As Long
    Dim Str_Val_1 As String
    Dim Deb As Long
 
    Deb = Timer
 
    Application.ScreenUpdating = False
 
    Set Fe = Worksheets("A")
 
    With Fe
 
        Set PlgTo = .[A20:A3379]
        Set PlgFrom = .[AD20:AD3379]
 
        PlgTo.ClearContents
 
        'le début de la formule étant le même, il ne sert à rien de la
        'reconstruire 690 fois
        Str_Val_1 = "=RC[-1]+sin(RC[-2]/R"
 
        For decal = 1 To 690
 
            'Copie successive des colonnes du tableau vers la colonne A20
            '1 seule colonne est rapatriée
            PlgTo = PlgFrom.Offset(0, decal).Value
 
            'La formule est bouclée sur la totalité des valeurs selectionnées
            For A = 20 To 469
 
                .[C20].FormulaR1C1 = Str_Val_1 & A & "C7)"
                .[C20].AutoFill .[C20:C3379]
 
                'Le résultat du test est copié dans la cellule en face de la valeur A
                'Ce n'est pas Le résultat du test mais la formule de C12 qui est copiée dans la cellule en face de la valeur A
                .[C12].Copy .Range("F" & A)
 
                'Recalcul des données en fonction de la valeur max tableau
                .[C20].FormulaR1C1 = Str_Val_1 & "17C6)"
                .[C20].AutoFill .[C20:C3379]
 
            Next A
 
            'Copie pour controler l'augmentation des resultats et incrémenter le test
            'Aucune copie n'est réalisée (pour controler l'augmentation des resultats et incrémenter le test)
            .[I1].Offset(decal - 1, 0).Value = .[F17].Value
 
            .[B20:B3379] = .[C20:C3379]
            .[T20:T3379] = .[C20:C3379]
 
        Next decal
 
    End With
 
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
 
    MsgBox "J'ai bossé " & Timer - Deb & " seconde"
 
End Sub

**el_slapper** · 02/05/2011, 11h44

Envoyé par AlainTech

Attention aux conseils donnés...
A chaque valeur de i, l'offset fera descendre d'une ligne.

Oooops, mille excuses

Correction d’un apprenti en VBA [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager