Ne plus utiliser SELECT

Le 07/02/2019 à 15:26

Bonjour à tous,

Vous trouverez ci-dessous mon code de macro qui fonctionne très bien mais qui prend un temps fou à se réaliser. Je sais que c'est à cause de select (et de moi surtout étant donné qu'utiliser select n'est pas une bonne idée). Je suis un novice dans le VBA et je l'utilise que très rarement, cependant j'aimerais que l'on m'aiguille sur comment ne pas utiliser select. Merci de vos retours et n'hésitez pas à me poser des questions.

Code :

Sub MAJ()
Application.ScreenUpdating = False
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim i As Integer
Dim j As Integer
Dim Z As Integer
Dim x As Integer
Dim y As Integer
Dim u As Integer
Dim week As Integer
Dim tache As Integer
i = 0
j = 0
Z = 0
B = 0
C = 0
D = 1

x = 3
y = 16
u = 7

week = InputBox("Saisir le num?ro de la semaine :")
Range("O5").Value = week
Sheets("Traitement donn?es").Activate
Range("B6").Activate

While ActiveCell.Value <> ""
    Sheets("Entr?e donn?es suivi jour").Activate
    Set Maplage = Range(Cells(y, x), Cells(y, u))
    Sheets("Traitement donn?es").Activate
    ActiveCell.Offset(D, -B).Value = Application.WorksheetFunction.Sum(Maplage)
    x = x + 5
    u = u + 5
    Z = Z + 1
        If Z = 52 Then
            B = Z
            D = D + 1
            y = y + 1
            x = 3
            u = 7
            Z = 0
        End If
    ActiveCell.Offset(0, 1 - B).Select
    B = 0
        C = Range("A1000").Value
        If D > C Then
        Range("A1").Select
        B = 0
        End If
Wend

Dim cell_b?ton_cumul? As Integer
Dim b?ton_cumul? As Range

Sheets("suivi b?ton").Activate
Range("A7").Activate
A = 1

    While ActiveCell.Value <> ""
    Sheets("Traitement donn?es").Activate
    Range(Cells(6 + A, 2), Cells(6 + A, week + 1)).Select
    Set b?ton_cumul? = Range(Cells(6 + A, 2), Cells(6 + A, week + 1))
    cell_b?ton_cumul? = Application.WorksheetFunction.Sum(b?ton_cumul?)
    Sheets("Suivi b?ton").Activate
    Range(Cells(6 + A, 10), Cells(6 + A, 10)).Value = cell_b?ton_cumul?
    ActiveCell.Offset(1, 0).Activate
    A = A + 1
    Wend

Application.ScreenUpdating = True
End Sub
Le 07/02/2019 à 15:54

Bonjour,

mets plutôt un fichier, car en plus ton code est truffé de ?

pourquoi mettre select si tu n'utilises pas selection dans ton code !

Le 07/02/2019 à 15:57

Bonjour,

J'ai commencé à reprendre ton code, car les select ne sont pas ses seuls soucis:

Sub MAJ()
Application.ScreenUpdating = False
Dim A As Integer, b As Integer, C As Integer, D As Integer, i As Integer, j As Integer, Z As Integer, _
x As Integer, y As Integer, u As Integer, week As Integer, tache As Integer
i = 0: j = 0: Z = 0: b = 0: C = 0: D = 1: x = 3: y = 16: u = 7

With Sheets("Traitement données")
der_lig = Range("b" & Rows.Count).End(xlUp).Row
If der_lig < 6 Then Exit Sub
End With

week = InputBox("Saisir le numéro de la semaine :")
Range("O5") = week
Sheets("Traitement données").Activate
Range("B6").Activate

While ActiveCell.Value <> ""
    Sheets("Entrée données suivi jour").Activate
    Set Maplage = Range(Cells(y, x), Cells(y, u))
    Sheets("Traitement données").Activate
    ActiveCell.Offset(D, -b).Value = Application.WorksheetFunction.Sum(Maplage)
    x = x + 5
    u = u + 5
    Z = Z + 1
        If Z = 52 Then
            b = Z
            D = D + 1
            y = y + 1
            x = 3
            u = 7
            Z = 0
        End If
    ActiveCell.Offset(0, 1 - b).Select
    b = 0
        C = Range("A1000").Value
        If D > C Then
        Range("A1").Select
        b = 0
        End If
Wend

Dim cell_beton_cumule As Integer
Dim beton_cumule As Range

Sheets("suivi béton").Activate
Range("A7").Activate
A = 1

    While ActiveCell.Value <> ""
    Sheets("Traitement données").Activate
    Range(Cells(6 + A, 2), Cells(6 + A, week + 1)).Select
    Set beton_cumule = Range(Cells(6 + A, 2), Cells(6 + A, week + 1))
    cell_beton_cumule = Application.WorksheetFunction.Sum(beton_cumule)
    Sheets("Suivi béton").Activate
    Range(Cells(6 + A, 10), Cells(6 + A, 10)).Value = cell_beton_cumule
    ActiveCell.Offset(1, 0).Activate
    A = A + 1
    Wend

Application.ScreenUpdating = True
End Sub

Le truc c'est que c'est difficile de tout modifier en ayant que le code, et ton code est hyper abstrait avec des variables qui pour moi ne veulent rien dire.

Ici, tu utilises beaucoup trop de select, activecell, et surtout aucun tableau, c'est un cumul de choses qui fait que ton programme est lent à exécuter.

Salut Steelson

Visiblement les ? sont des "é"

Le 07/02/2019 à 16:34

Effectivement les ? sont des é.

Ci-dessous le fichier :

9suivi-beton-indice0.xlsm (241.67 Ko)

Effectivement je bricole en VBA c'est pourquoi j'ai envie de comprendre un peux mieux comment on code pour aller plus vite et être efficace. Merci de l'aide !

Le 07/02/2019 à 16:47

Le but est de rentrer tous les jours les quantités de béton utilisées pour diverses taches et d'en extraire les données quelque soit la semaine demandée. Sur le long terme j'aurai aimé mettre un formulaire pour intégrer directement la date et le nom de la tache pour remplir le tableur excel et d'autre part suivre l'avancement visuellement à l'aide de graphiques etc...

Le but est également de copier ce fichier pour suivre les heures passées sur différentes tâches. J'essaie donc de faire quelque chose de réutilisable !

Seul bémol : j'apprends seulement via les forums et je ne peux pas trop y passer de temps…

Le 13/02/2019 à 09:24

Bonjour,

Je me permets de revenir vers vous pour savoir si vous avez pu étudier le fichier que j'ai déposé. J'avoue être dans le flou et je ne sais pas comment optimiser le code.

Vous remerciant d'avance du temps que vous passerez à me répondre !

Le 13/02/2019 à 09:26

Bonjour,

Tu as raison de relancer le sujet, j'avais oublié ce sujet dans la gestion de mes notifications, je crois que je suis passé dessus et que je pensais qu'il était résolu, je regarde ça

Le 13/02/2019 à 09:54

Re

Je suis entrain d'étudier ton programme fait maison, j'ai commencé par renommer les variables pour mieux comprendre ce que tu fais, et mettre 2-3 commentaires afin d'identifier les étapes de ton programme, et de ce que je vois, tu perds énormément de temps de traitement, et pas seulement dans des Select, la feuille "Traitement données" n'est rien d'autre qu'une pâle copie d'un tableau VBA, tu perds énormément de temps car tu n'en n'as pas utilisé d'ailleurs, je vais voir pour te faire quelque chose qui fait pareil, mais en énormément plus rapide.

Pour le moment le code ressemble à ça:

Sub MAJ()
Application.ScreenUpdating = False
Nsem = 0: DecCol = 0: NbVal = 0: DecLig = 1: col_dep = 3: LigSuivi = 16: col_fin = 7

'i ne sert à rien
'j ne sert à rien

With Sheets("Traitement données")
der_lig = Range("b" & Rows.Count).End(xlUp).Row
If der_lig < 6 Then Exit Sub
End With

week = InputBox("Saisir le numéro de la semaine :")
Range("O5") = week
Sheets("Traitement données").Activate
Range("B6").Activate

While ActiveCell.Value <> ""
    'somme de chaque semaines de chaque ligne
    'enregistrement plage à traiter
    Sheets("Entrée données suivi jour").Activate
    Set Maplage = Range(Cells(LigSuivi, col_dep), Cells(LigSuivi, col_fin))

    Sheets("Traitement données").Activate
    ActiveCell.Offset(DecLig, -DecCol).Value = Application.WorksheetFunction.Sum(Maplage) 'somme des valeurs

    'changement de semaine
    col_dep = col_dep + 5
    col_fin = col_fin + 5
    Nsem = Nsem + 1
        If Nsem = 52 Then
            DecLig = DecLig + 1
            LigSuivi = LigSuivi + 1
            col_dep = 3
            col_fin = 7
            Nsem = 0
        End If
    ActiveCell.Offset(0, 1 - Nsem).Select
        NbVal = Range("A1000").Value
        If DecLig > NbVal Then
        Range("A1").Select
        End If
Wend

Dim cell_beton_cumule As Integer
Dim beton_cumule As Range

Sheets("suivi béton").Activate
Range("A7").Activate
A = 1

    While ActiveCell.Value <> ""
    Sheets("Traitement données").Activate
    Set beton_cumule = Range(Cells(6 + A, 2), Cells(6 + A, week + 1))
    cell_beton_cumule = Application.WorksheetFunction.Sum(beton_cumule) 'somme de la 1ère semaine à la semaine choisie
    Sheets("Suivi béton").Activate
    Cells(6 + A, 10) = cell_beton_cumule 'on met la valeur de dépense
    ActiveCell.Offset(1, 0).Activate 'changement de ligne
    A = A + 1
    Wend

Application.ScreenUpdating = True
End Sub
Le 13/02/2019 à 10:19

Re,

troisième poste d'affilé je sais, mais si je modifie juste un message, tu n'auras pas notification.

J'ai donc repris tout ton programme en le simplifiant énormément, car tu t'étais vraiment pris la tête avec tes calculs, il fonctionnait d'après toi, mais je comprenais qu'il soit lent, je te propose une version optimisée qui fonctionne avec des tableaux VBA, la feuille "Traitement données" ne sert plus à rien pour le programme:

Le fichier:

6copie-de-suivi-beton-indice0.xlsm (239.24 Ko)

Le code:

Sub MAJ()
Application.ScreenUpdating = False
'Initialisations
Dim TabSuivi As Variant, TabSomme As Variant
Dim Nsem

With Feuil1
    der_lig = .Range("a" & Rows.Count).End(xlUp).Row
    der_col = .Cells(16, Columns.Count).End(xlToLeft).Column
    TabSuivi = .Range("c16", .Cells(der_lig, der_col))
End With

ReDim TabSomme(LBound(TabSuivi, 1) To UBound(TabSuivi, 1), 1 To 1)

Nsem = CDbl(InputBox("Saisir le numéro de la semaine :"))
Range("O5") = Nsem

'somme des semaines
For i = LBound(TabSomme, 1) To UBound(TabSomme, 1)
    For j = 1 To 5 * Nsem
        TabSomme(i, 1) = TabSomme(i, 1) + TabSuivi(i, j)
    Next j
Next i

'export des valeurs de somme
With Feuil2
    .Range("j7", "j" & 6 + UBound(TabSomme, 1)) = TabSomme
End With

Application.ScreenUpdating = True
End Sub
Le 13/02/2019 à 12:05

Merci beaucoup !

Je me doutais que cette feuille traitement de données pouvait être remplacée par une matrice. Je regarde ton code pour essayer de le comprendre et te poser des questions le cas échéant (ce qui sera le cas^^). Je note tout de même le sujet comme résolu.

Le 13/02/2019 à 14:25

Re,

J'ai du mal à saisir ce qui se passe exactement au niveau de cette ligne de code :

ReDim TabSomme(LBound(TabSuivi, 1) To UBound(TabSuivi, 1), 1 To 1)

Je sais que c'est pour redéfinir la taille d'un tableau, cependant je ne comprends pas ce qui se passe exactement.

Est-ce qu'il est possible de m'éclairer ?

Le 13/02/2019 à 14:35

Re

En effet, cette ligne de code sert à redimensionner un tableau dont on va préciser les dimensions, en fait, pour le moment, le tableau TabSomme est de dimensions inconnues, on a juste dis que c'était un tableau au tout début du code, sauf que pour mettre des données dedans, il faut lui donner de la place.

C'est le but de cette instruction, elle alloue de la mémoire de ton ordinateur pour créer un tableau vide, avec des dimensions connues.

Ici

ReDim TabSomme(LBound(TabSuivi, 1) To UBound(TabSuivi, 1), 1 To 1)

Sert à dimensionner le tableau TabSomme, on lui donne ensuite les informations pour 2 dimensions, les lignes et les colonnes, on regarde ça de plus près:

LBound(TabSuivi, 1) To UBound(TabSuivi, 1)

Un tableau peut commencer à 0, tout comme il peut commencer à 1, 2, 3... ça dépend de comment il est déclaré par exemple, ici je précise qu'il commence par lbound de TabSuivi sur la dimension 1, autrement dis, la borne inférieure du tableau sur les lignes, en clair, le numéro de sa première ligne, et je précise ensuite que le tableau TabSomme ira de ce numéro de ligne à la limite supérieure du tableau TabSuivi, en clair, il aura autant de lignes que le tableau TabSuivi, et commencera par le même numéro de ligne.

ensuite:

1 To 1

ce passage permet de dire combien de colonnes le tableau contiendra et à quel numéro de colonne on commencera, ici on commence avc la colonne 1, et on en a seulement 1 car on finit aussi par la colonne 1.

La raison pour laquelle je lui donne deux dimensions, et pas seulement des lignes, c'est qu'au moment d'exporter les valeurs du tableau, si il n'est qu'à une dimension, ça ne ressort que la première ligne du tableau sur l'ensemble de la colonne J...

J'espère avoir été plus clair

Cette instruction est super utile quand tu ne sais pas à l'avance quelle taille fera ton tableau, comme tu ne peux pas l'initialiser avec des variables, TabSomme(x,y) ne marchera pas par exemple, il faut faire Dim TabSomme as variant puis ReDim TabSomme(x,y).

Le 18/02/2019 à 16:49

Bonjour,

Merci une nouvelle fois pour ton aide Ausecour et tes explications claires. Je n'ai cependant pas eu le temps de m'y replonger avant aujourd'hui. J'essaie de reprendre ce que tu as fais pour remplir les colonnes Dépense de la semaine précédente et de la semaine actuelle de la feuille Suivi béton, à savoir les colonnes F et N (sans faire de mauvais jeu de mot)...

Le code fonctionne mais ne prend en compte que la dernière colonne du tableau TabSuiviS, je me demande si ça ne viendrait pas de la somme mais j'avoue que c'est encore trop flou dans mon esprit (manque de pratique) pour que je puisse bien identifier d'où vient le problème.

Merci d'avance à ceux qui y jetteront un œil.

Voici le code que j'ai rajouté :

Sub MAJ()
Application.ScreenUpdating = False
'Initialisations
Dim TabSuiviC As Variant, TabSuiviS As Variant, TabSuiviSN1 As Variant, TabSommeC As Variant, TabsommeS As Variant, TabsommeSN1 As Variant
Dim Nsem

Nsem = CDbl(InputBox("Saisir le num?ro de la semaine :"))
Range("O5") = Nsem

With Feuil1
    der_lig = .Range("a" & Rows.Count).End(xlUp).Row
    der_col = .Cells(16, Columns.Count).End(xlToLeft).Column
    TabSuiviC = .Range("c16", .Cells(der_lig, der_col))
    TabSuiviS = .Range(.Cells(16, Nsem * 5 - 2), .Cells(der_lig, der_col))
End With

ReDim TabSommeC(LBound(TabSuiviC, 1) To UBound(TabSuiviC, 1), 1 To 1)

ReDim TabsommeS(LBound(TabSuiviS, 1) To UBound(TabSuiviS, 1), 1 To 1)

'somme des semaines
For i = LBound(TabSommeC, 1) To UBound(TabSommeC, 1)
    For j = 1 To 5 * Nsem
        TabSommeC(i, 1) = TabSommeC(i, 1) + TabSuiviC(i, j)
    Next j
Next i

For i = LBound(TabsommeS, 1) To UBound(TabsommeS, 1)
    For j = 1 To 5
        TabsommeS(i, 1) = TabsommeS(i, 1) + TabSuiviS(i, j)
    Next j
Next i

'export des valeurs de somme
With Feuil2
    .Range("j7", "j" & 6 + UBound(TabSommeC, 1)) = TabSommeC
    .Range("n7", "n" & 6 + UBound(TabSuiviS, 1)) = TabSuiviS
End With

Application.ScreenUpdating = True
End Sub
Le 19/02/2019 à 08:10

Bonjour,

Pour que l'on puisse traiter correctement ta demande, pourrais-tu joindre un fichier en montrant clairement l'anomalie? et le résultat attendu? Pour que l'on puisse voir l'écart qu'il y a et potentiellement trouver des pistes de résolution pour ton problème.

A bientôt

Le 19/02/2019 à 09:11

Le but est le suivant :

Si la semaine en cours est la semaine 2:

Colonne N : avoir le résumé de la semaine en cours à savoir ligne par ligne : Que la somme la ligne H16:L16 de la feuille Entrée… soit inscrite dans la cellule N7 de la feuille suivi béton et ainsi de suite pour les lignes suivantes.

Exemple :

Attendu :

  • Tableau Entrée données suivi jour H16:L16 : Lundi : 10m3, Mardi : 0m3 .... Vendredi : 10 m3
  • Tableau Suivi béton N7 : 20m3

Résultat code :

  • Tableau Suivi béton N7 : 10m3

Mon code ne prend en compte que le vendredi et je ne comprends pas pourquoi....

4copie-de-suivi-beton-indice0.xlsm (237.05 Ko)
Le 19/02/2019 à 10:18

Re,

J'ai modifié un peu ton code, je te retourne le fichier, le résultat me semble bon, tu me diras si c'est le cas

4copie-de-copie-de-suivi-beton-indice0.xlsm (242.05 Ko)
Rechercher des sujets similaires à "utiliser select"