Microsoft 365 accélérer une boucle

vg026u · 12 Janvier 2023

Bonjour à tous,

Je suis en train de faire une macro VBA et j'ai une boucle qui me prend beaucoup de temps lors de son exécution. Y aurait-il un moyen d'accélérer le pocessus. Je ne connais pas bien toutes les fonctions VBA et j'avoue que j'atteins la limite des mes lointaines bases en code VBA

VB:

'copie des données U et V
    Sheets("Data").Select
    Range("U35:V35").Select
    Selection.Copy
    'Collage des données U et V en fonction de la colonne AB
    Sheets("Suivi Prototypes").Select
    Dim x As Long, y As Long, z As Long
    z = Application.WorksheetFunction.CountA(ActiveWorkbook.Sheets("Suivi Prototypes").Range("AB7:AB100000"))
    x = z + 6
    For y = 7 To x
        If Cells(y, 28) <> 1 Then
            Cells(y, 21).Select
            ActiveSheet.Paste
        End If
    Next

Merci d'avance pour votre aide.

Vincent

Phil69970 · 12 Janvier 2023

Bonjour @vg026u et bienvenu sur XLD

Une remarque :

-J'ai pas vu le fichier

Et si tu expliquais clairement ce que tu veux faire ......

@Phil69970

sylvanu · 12 Janvier 2023

Bonjour Vg026u, Phil,
C'est vrai qu'un fichier test est bien utile. Ca évite qu'on se le tape !
En PJ la macro juste un peu remaniée, mais les résultats sont déjà éloquents sur mon PC avec un fichier de 1000 lignes. 40 fois plus rapide :

Avec:

VB:

Sub Copie()
'copie des données U et V
    Application.ScreenUpdating = False
    Data1 = Sheets("Data").Range("U35")
    Data2 = Sheets("Data").Range("V35")
    'Collage des données U et V en fonction de la colonne AB
    Sheets("Suivi Prototypes").Select
    Dim x As Long, y As Long, z As Long
    z = Application.WorksheetFunction.CountA(ActiveWorkbook.Sheets("Suivi Prototypes").Range("AB7:AB100000"))
    x = z + 6
    For y = 7 To x
        If Cells(y, 28) <> 1 Then
            Cells(y, 21) = Data1
            Cells(y, 22) = Data2
        End If
    Next
End Sub

On doit pouvoir être un peu plus rapide, en se grattant la tête un petit peu.

Dranreb · 12 Janvier 2023

Bonjour.
Résultat de mon grattage de tête :

VB:

   Dim TData(), WshProto As Worksheet, TPrAB(), TPrUV(), L As Long
   TData = Worksheets("Data").[U35:V35].Value
   Set WshProto = Worksheets("Suivi Prototypes")
   TPrAB = WshProto.[AB7].Resize(WshProto.[AB100000].End(xlUp).Row - 6).Value
   TPrUV = WshProto.[U7].Resize(UBound(TPrAB, 1), 2).Value
   For L = 1 To UBound(TPrUV, 1)
      If TPrAB(L, 1) <> 1 Then
         TPrUV(L, 1) = TData(1, 1)
         TPrUV(L, 2) = TData(1, 2)
         End If
      Next L
   WshProto.[U7].Resize(UBound(TPrUV, 1), 2).Value = TPrUV

sylvanu · 12 Janvier 2023

Hello Dranreb,
Plus rapide que moi ! avec la même idée :

VB:

Sub CopieParArray()
'copie des données U et V
    Application.ScreenUpdating = False
    Data1 = Sheets("Data").Range("U35")
    Data2 = Sheets("Data").Range("V35")
    tablo = Range("U1:AB" & Range("AB1000000").End(xlUp).Row) ' Tranfert données dans Tablo
    Sheets("Suivi Prototypes").Select
    Dim x As Long, y As Long, z As Long
    For y = 7 To UBound(tablo)
        If tablo(y, 8) <> 1 Then
            tablo(y, 1) = Data1
            tablo(y, 2) = Data2
        End If
    Next
    [U1].Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo
End Sub

Résultat sans appel :

vg026u · 13 Janvier 2023

Bonjour à tous,

Merci pour vos réponses vous avez été super réactifs j'avoue que je m'attendais pas a avoir une réponse si rapide!

Je teste ça lundi et je vous fais un retour

Encore merci pour vos grattage de tête

Vincent

vg026u · 16 Janvier 2023

Bonjour à tous,

Je reviens vers vous car cela fonctionne mais pas tout a fait comme espéré.
Comme l'a précisé Phil69970, je n'ai pas expliqué mon objectif pour cette macro ni mi un fichier test.
J'ai un fichier (exemple ci-joint) qui contient un tableau de données. J'extrais de celui-ci des informations qui me permettent par la suite d'alimenter un planning et des graphiques croisés dynamiques.
Ce tableau est susceptible d'être modifié et d'avoir des lignes supprimée. Hors en colonne U et V, j'ai inscrit une formule faisant référence à celle du dessus et quand on supprime cette cellule j'ai un #Réf! qui apparait et me fausse mes informations dans les GCD.
Pour palier à ça je voulais intégrer dans ma macro "miseenformeauto" une séquence pour copier la formule présente dans une cellule des colonne U et V (la 35 mais ça peu être n'importe laquelle) et la collé avec incrémentation avec la condition que j'ai donné (= si la valeur dans la cellule de la colonne AB correspondant <> 1)

Le code donné fonctionne très bien si ce que j'avais a copié était une valeur ou une donnée texte. Cependant j'aimerais pouvoir copier la formule. J'ai testé avec .Formula au lieu de .Value mais la cela colle la formule sans incrémentation

Y a-t 'il une fonction qui permettrait de coller avec incrémentation dans VBA?

Merci d'avance pour vos retours

Vincent

Dranreb · 16 Janvier 2023

Bonjour.
Et vous ne pouvez pas mettre en Tableau3[Date inspection2] :

Code:

=SI(DECALER([@[Date inspection]];-1;0)="";DECALER([@[Date inspection2]];-1;0);[@[Date inspection]])

vg026u · 16 Janvier 2023

Désolé je ne comprends pas ,
Mon soucis initiale de #Réf! est dans la colonne AA. c'est celle que j'utilise pour me donner une information dans mon GCD et vu que la formule de cette colonne fait référence à la cellule de colonne U correspondante cela me donne une mauvaise information dans mon GCD.

sylvanu · 16 Janvier 2023

Bonjour,
Evidemment ça change tout. Une PJ en post #1 aurait éviter tout ce travail.
Une piste simple pour accélérer : mettre Application.ScreenUpdating = False juste après le Sub.
Sur votre fichier et votre macro du post #1 on passe, sur mon PC, de 0.8 à 0.25s, soit 3.2 plus rapide.

En simplifiant un peu, dans le même contexte on passe à0 .18s soit 4.4 plus rapide. Est ce suffisant ?
( à noter qu'appliqué à mon fichier de 1000 lignes, ça fait 13s !!! )
Avec :

VB:

Sub Essai()
    Dim x As Long, y As Long, z As Long
    Application.ScreenUpdating = False
    Sheets("Suivi Prototypes").Select
    x = Application.CountA(Range("AB7:AB100000")) + 6
    For y = 7 To x
        If Cells(y, 28) <> 1 Then
            Cells(y, 21).FormulaLocal = "=SI($F26=$F25;U25;"""")"
            Cells(y, 21).FormulaLocal = "=SI($F26=$F25;V25;"""")"
        End If
    Next
End Sub

vg026u · 16 Janvier 2023

Pardon, j'ai pas l'habitude des forums. je mettrais des fichiers la prochaine fois

j'ai bien stopper la mise a jour de l'écran au tout début de mon code

Votre code fonctionne mais de ce fait il me copie la formule "=SI($F26=$F25;U25;"""")" dans toutes les cases. j'aurais besoin que la formule corresponde à la ligne de la cellule où elle est copiée:
exemple pour la cellule U128 : "=SI($F128=$F127;U127;"""")" et pour la U214 : "=SI($214=$F214;U214;"""")" mais que pour les cellules où la cellule de la colonne AB <> 1

Est-ce possible de demander ça a VBA?

Dranreb · 16 Janvier 2023

Mais si c'est la même formule dans toute la colonne et dans un tableau Excel de surcroit, pourquoi ne pas mettre une fois pour toute la formule en références structurées quitte à utiliser DECALER(@[…];-1;0) pour se référer à la ligne précédente ?
Remarque: que faut-il mettre en Statut Prototype si [@[NB statut (all)]]=1 ?

En 'Suivi Prototypes'!U8, par exemple, au lieu de :

Code:

=SI($F8=$F7;U7);"")

partir de l'idée de :

Code:

=SI($F8=DECALER($F8;-1;0);DECALER(U8;-1;0);"")

Pourrait certes s'écrire

VB:

.FormulaR1C1 = "=IF(RC6=OFFSET(RC6,-1,0),OFFSET(RC,-1,0),"""")"

Mais comme avec ce style R1C1, pareil pour toutes les lignes bien que propre à chacune, en références structurée c'est plus clair, valable en Formula comme en FormulaR1C1 :

VB:

.Formula = "=IF([@PO]=OFFSET([@PO],-1,0),OFFSET([@[Statut Prototype]],-1,0),"""")"

Code:

=SI([@PO]=DECALER([@PO];-1;0);DECALER([@[Statut Prototype]];-1;0);"")

En tout cas avec un DECALER(…;-1;0) plus de #REF! quand on supprime une ligne puisqu'on se réfère toujours à la ligne précédente quelle qu'elle soit ou devienne, elle n'est plus figée !

vg026u · 17 Janvier 2023

Merci Dranreb pour ta réponse. Effectivement je ne connaissais pas la fonction DECALER ça éliminera mon problème de base et m'évitera cette boucle dans mon code VBA
Quant à [@[NB statut (all)]]=1 il y aura un texte qui me donnera l'avancement du prototype type "Validé" "en cours" qui sera a compléter par quelqu'un via une liste déroulante.
Mon code était finalement plus la pour corriger un problème que je ne savais pas résoudre autrement. La formule DECALER me convient très bien

Merci pour votre aide ! cette fonction va m'être bien pratique!

Vincent

Microsoft 365 accélérer une boucle

vg026u

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Pièces jointes

vg026u

XLDnaute Nouveau

vg026u

XLDnaute Nouveau

Pièces jointes

Dranreb

XLDnaute Barbatruc

vg026u

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

vg026u

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

vg026u

XLDnaute Nouveau

Discussions similaires