[Résolu] Macro très longue à exécuter

[ZiM]

Bonjour à tous les lecteurs !

Je viens vers vous suite à une macro qui me pose problème (pomper je le confesse sur : Fusionner plusieurs lignes : Excel - VBA).

Cette macro prends plus d'une minute pour faire le boulot (ok c'est toujours mieux qu'à la main...)

Sub Regroupe()
'Attention ! Les données doivent être triées en colonne A
Application.ScreenUpdating = False
Dim Lig As Long, i As Long, j As Long, k As Long

Range("A2:K5000").Activate
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Dernière Ligne
Lig = Range("A5000").End(xlUp).Row

'De la dernière ligne à la ligne 2
For i = Lig To 2 Step -1

'De la colonne 2 (B) à la colonne 11 (K)
For j = 2 To 11
'Si la valeur de la cellule de la colonne A est égale à la valeur de la cellule de la ligne au-dessus
If Cells(i, 1) = Cells(i - 1, 1) Then

'Si la cellule de la colonne étudiée est non vide
If Cells(i, j) <> "" Then

'On fait un COUPER-COLLER sur la ligne au-dessus
Cells(i, j).Cut Destination:=Cells(i - 1, j)

End If
End If

'Colonne suivante à étudier
Next j

'Ligne suivante à étudier
Next i

End Sub

Cette dernière fonctionne à merveille mais prends une plombe de temps à effectuer ses actions (pourtant simple non ?).

Petite explication de la mécanique :

Tout d'abord, je sélectionne ma plage (variable mais je définie une grande zone éventuellement à améliorer) et je réalise un collage spécial pour supprimer les formules (réaliser en VBA le triage et rechercheV nécessaire est au dessus de mes capacités).

J'ai une base de donnée variable dans la composition et la longueur mais normé après un traitement tel que présenté(extraction d'un site internet). Pour cela tout va bien.

Je réalise ce traitement pour trier des événements en deux cas (A et B dans mon document anonyme) et les regrouper pour compléter la première ligne (Si la cause A est remplie la B est forcément vide dans une seconde ligne mais il ne peut y avoir qu'une seul ligne cause A ou cause B). Le traitement doit avoir pour référence les valeurs de la colonne "B" à comparer. Le trie de ces valeurs est réaliser avant mais je n'ai pas alourdie la macro car elle rame déjà ^^.

Dans l'absolue mon outil ne prends pas en compte une cause B seule mais rien ne m'oblige à les traiter donc possibilité d'effacement des causes B sans la cause A (l'élément de comparaison restant la colonne "B").

Suite à ce bricolage, je souhaite effacer chaque ligne prélevé (bug dans le code qui laisse présent la colonne A mais c'est pas éliminatoire) pour compléter la précédente et surtout pas supprimer car sinon derrière tout part en vrille (car ce petit bout fait partie d'un grand ensemble).

Bref l'objectif est plus compliquer à expliquer que la lecture du code VB ...

Si je ne suis pas explicite je peu apporté des précisions !

Je vous remercie par avance de prendre un peu de votre temps pour un petit coup de pouce !

 

[TooFatBoy]

Re : Macro très longue à exécuter

Bonjour,

En mettant ton premier If (teste de la première cellule de la ligne en cours) entre les deux For, tu devrais déjà gagner un peu de temps.

 

[Misange]

Re : Macro très longue à exécuter

Bonjour
en début de macro :

Application.ScreenUpdating = False
ModeRecalcul = Application.Calculation ' Réglage du recalcul sur mode manuel Application.Calculation = xlCalculationManual ' [...] Instructions ' Rétablissement du mode de recalcul d'origine Application.Calculation = ModeRecalcul
Application.ScreenUpdating = True

ceci évite que les formules de ta feuille se recalculent quand tu modifies tes lignes et évite la mise à jour de l'écran pendant l'opération. Cela devrait de toute façon te faire gagner pas mal de temps.
Sinon sans voir tes données avec tes explications et à cette heure, mes yeux se ferment !

 

[mapomme]

Re : Macro très longue à exécuter

Bonjour ZiM, Marcel32, Misange,

Sans fichier joint , difficile de savoir si on a bien compris et de vérifier quoi que ce soit
On pourra toujours essayer ce code écrit à l'aveugle et non testé!

Sub PasDeFichierPasDeVerif()
'avec suppression des lignes vides

Dim tablo, xrg As Range, i&, j&, DerLig
 
  Range("A2:K5000") = Range("A2:K5000").Value
  Set xrg = Range("a5000").End(xlUp)
  Set xrg = Range("a1:k" & xrg.Row)
  tablo = xrg.Value
  DerLig = UBound(tablo)
 
  For i = DerLig To 2 Step -1
    If tablo(i, 1) = tablo(i - 1, 1) Then
      For j = 1 To 11
        If Len(tablo(i, j)) > 0 Then
          tablo(i - 1, j) = tablo(i, j)
          tablo(i, j) = Empty
        End If
      Next j
    End If
  Next i
 
  xrg.Value = tablo
  On Error Resume Next
  xrg.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0
End Sub

Pour augmenter vos chances de réponse, il est fortement recommandé de fournir un fichier exemple:

• Non pas un fichier complet mais un "petit" fichier extrait de votre fichier de travail en ne conservant que quelques lignes par feuille.
• Fichier expurgé de toutes données nominatives et confidentielles.
• Avec une feuille montrant le résultat souhaité et avec les explications qui vont bien.

Pour joindre un fichier:
Quand vous rédigez un nouveau message ou quand vous modifiez un de vos messages, passez en mode avancé et cliquez sur 'Gérer les pièces jointes' ou bien cliquez directement sur l'icone 'Trombone'.
Choisissez vos fichiers (boutons Choisir un fichier), cliquez sur envoyer (bouton envoyer) pour les charger, quand ils sont chargés (les noms des fichiers s'affichent en couleur) refermez la fenêtre (bouton Fermer cette fenêtre) puis cliquez sur 'envoyez...' ou 'enregistrer les changements'.

 

[ZiM]

Re : Macro très longue à exécuter

Merci de votre aide !

J'avais pourtant éditer mon message hier soir pour palier à cet oublie ...

et à cette heure, mes yeux se ferment !

Je prends pour moi ta citation Misange ^^ Bon le premier poste est corrigé !

Pour le bout de code proposé par Misange :

Application.ScreenUpdating = False
ModeRecalcul = Application.Calculation ' Réglage du recalcul sur mode manuel Application.Calculation = xlCalculationManual ' [...] Instructions ' Rétablissement du mode de recalcul d'origine Application.Calculation = ModeRecalcul
Application.ScreenUpdating = True

Il est à couper en début et fin de macro non ? Je désactive en début je relance en fin ?
J'avais déjà fait un test avec le calcul manuel mais sans l'intégrer en VB donc je ne pense pas que cela vienne de cela. J'ai également créé le classeur en PJ pour tester si cela ne viens pas d'ailleurs. Vous connaissez les réponses ^^

Je fais les test ce soir car le boulot n'attends pas !

Merci pour vos recherches.

 

[Misange]

Re : Macro très longue à exécuter

Oups le copier coller a fait des siennes, voici le bon code :

Application.ScreenUpdating = False
'on enregistre le mode de calcul présent actuellement pour le rétablir à la fin
ModeRecalcul = Application.Calculation 
' Réglage du recalcul sur mode  manuel 
Application.Calculation = xlCalculationManual 

'le reste de ton code


' Rétablissement du mode de recalcul d'origine 
Application.Calculation = ModeRecalcul
Application.ScreenUpdating = True

Mais de fait si tu commences par supprimer les formules le recalcul est inexistant.
Le classeur que tu nous a envoyé ne permet pas de tester quoi que ce soit : les lignes sont visiblement déjà traitées. Donne nous plutot une base à nettoyer

La macro proposée par mapomme sera de toute manière beaucoup beaucoup plus rapide que celle que tu as car elle passe par un tableau interne (array) : toutes les données sont en une seule fois, sans boucle passées de la feuille vers l'array, nettoyées en VBA dans l'array et réinjectées en une fois dans la feuille.

plus d'infos sur les arrays ici
Ce lien n'existe plus

 

[ZiM]

Re : Macro très longue à exécuter

Bonjour, merci de votre implication !

En effet, le code de mapomme est "exel"lent (ok je sort).

Il supprime les données inutiles, fonctionne vite et regroupe correctement !
Efficace et rapide quoi.

Je passe le topic en résolu !