XL 2019 C'est lent mais alors lent

sebastien450 · 22 Janvier 2023

Bonsoir,
J'ai un code avec des boucles imbriqués qui est bien lent et donc je viens vers vous pour apprendre.
En piste pour alléger le code :
1 / sur ma plage, les cellules à tester sont toutes les lignes avec un pas de 8, mais je ne sais pas l'écrire.
2 / Et je ne sais pas sortir de la multi imbrication quand j'ai trouvé mon résultat.

VB:

Set plage = Feuil1.Range(Cells(6, 3000), Cells(214, 5000))
ncol = plage.Columns.Count
Tablo = plage
Dim cible As Variant
For lig8 = 2 To 500
cible = Feuil8.Cells(lig8, 1).Value ' je cherche ma cible sur le range
                    For i = 1 To UBound(Tablo)
                        For J = 1 To ncol
                            If UCase(Tablo(i, J)) = cible Then
                            'blablabla'
                            Feuil8.Cells(lig8, 18).Value = "PLANIFIE": Exit For 'je passe la la lig8 suivante?
                            End If
                 Next J, i
Next lig8
MsgBox "Durée d'exécution: " & Format(Now - MacroDebut, "hh:mm:ss")
Application.ScreenUpdating = True

Merci de vos éclairages.

vgendron · 22 Janvier 2023

Bonsoir

ce serait plus pratique d'avoir un bout de fichier exemple pour comprendre ce que ton code fait

sinon pour une boucle qui parcourt les lignes de 8 en 8
For lig8 = 2 To 500 step 8

cette ligne ne fait pas ce que tu écris en commentaire
cible = Feuil8.Cells(lig8, 1).Value ' je cherche ma cible sur le range
ca ne cherche pa.. ca affecte la valeur de la cellule A,lig8 à la variable cible..
après. sans doute que ton commentaire était pour la boucle complète..

et pour sortir d'une boucle for, il te suffit d'écrire
exit for

dernier ajout sur ce post
pour chercher une valeur dans une plage, plutot que parcourir toutes les cellules une par une, tu peux utiliser la fonction "find"

exemple

VB:

ValCible = 5 'valeur à chercher.. ca pourrait aussi etre du texte
Set plage = Feuil1.Range(Cells(6, 3000), Cells(214, 5000))

set trouve=plage.find(ValCible)
if not trouve is nothing then
   msgbox trouve.address
end if

sylvanu · 22 Janvier 2023

Bonsoir Sebastien, Vgendron,
@Sébastien,
Vous êtes sur de votre plage?

VB:

plage = Feuil1.Range(Cells(6, 3000), Cells(214, 5000))

Ca correspond à :

Code:

plage = Feuil1.Range("DKJ6:GJH214")

Il est rare de voir des plages dans ce genre de colonnes.

Mais c'est vrai qu'un petit fichier test ....

sebastien450 · 23 Janvier 2023

Bonjour,
Ci-joint un fichier test.
Mon code est dans le module1.
Ma plage est en réalité plus grande mais c'est pour l'exemple - vous la trouverez sur la feuille" planning".

Bernard_XLD · 23 Janvier 2023

Bonjour sebastien450, vgendron, sylvanu, le forum

@sebastien450 ,ma foi, vous aviez commencé en tableau, il fallait finir en tableau, les sélections sont toujours couteuses en temps. Vite fait et pas testé mais si le code du post 1 fonctionne, celui là devrait fonctionner aussi en plus rapide.
Et quand vous parlez de pas de 8, vous voulez dire quoi exactement ?
Toutes les 8 lignes à partir de la ligne 2 ? ou autre chose ?

Cordialement, @+

VB:

Set plage = Feuil1.Range(Cells(6, 3000), Cells(214, 5000))
ncol = plage.Columns.Count
Tablo = plage
Dim cible As Variant

Dim Tablo2Ref As Range, Tablo2Val, Tablo2Cible
Set Tablo2Ref = Feuil8.Range(Feuil8.Cells(2, 18), Feuil8.Cells(500, 18))
Tablo2Val = Tablo2Ref.Value
Tablo2Cible = Feuil8.Range(Feuil8.Cells(2, 1), Feuil8.Cells(500, 1)).Value

For lig8 = LBound(Tablo2Val, 1) To UBound(Tablo2Val, 1)
    For i = 1 To UBound(Tablo)
        For J = 1 To ncol
            If UCase(Tablo(i, J)) = Tablo2Cible(lig8, 1) Then
                'blablabla'
                Tablo2Val(lig8, 1) = "PLANIFIE": Exit For 'je passe la la lig8 suivante?
            End If
        Next J
        If Tablo2Val(lig8, 1) = "PLANIFIE" Then Exit For
    Next i
Next lig8
Tablo2Ref.Value = Tablo2Val
MsgBox "Durée d'exécution: " & Format(Now - MacroDebut, "hh:mm:ss")
Application.ScreenUpdating = True

Bernard_XLD · 23 Janvier 2023

Re,

le même avec un test toutes les huit lignes de feuil1

Cordialement, @+

VB:

Set plage = Feuil1.Range(Cells(6, 3000), Cells(214, 5000))
ncol = plage.Columns.Count
Tablo = plage
Dim cible As Variant

Dim Tablo2Ref As Range, Tablo2Val, Tablo2Cible
Set Tablo2Ref = Feuil8.Range(Feuil8.Cells(2, 18), Feuil8.Cells(500, 18))
Tablo2Val = Tablo2Ref.Value
Tablo2Cible = Feuil8.Range(Feuil8.Cells(2, 1), Feuil8.Cells(500, 1)).Value

For lig8 = LBound(Tablo2Val, 1) To UBound(Tablo2Val, 1)
    For i = 1 To UBound(Tablo) Step 8
        For J = 1 To ncol
            If UCase(Tablo(i, J)) = Tablo2Cible(lig8, 1) Then
                'blablabla'
                Tablo2Val(lig8, 1) = "PLANIFIE": Exit For 'je passe la la lig8 suivante?
            End If
        Next J
        If Tablo2Val(lig8, 1) = "PLANIFIE" Then Exit For
    Next i
Next lig8
Tablo2Ref.Value = Tablo2Val
MsgBox "Durée d'exécution: " & Format(Now - MacroDebut, "hh:mm:ss")
Application.ScreenUpdating = True

sebastien450 · 23 Janvier 2023

Quelle réactivité, merci
En effet le saut de ligne intervient sur le premier tablo dés la ligne 6, donc la dernière proposition colle parfaitement.

Dans le code j'aimerais éclaircir ce point :

VB:

Tablo2Val(lig8, 1) = "PLANIFIE": Exit For 'je passe la la lig8 suivante?

Etant dans des boucles imbriqué le "exit for" ne permet pas de sortir directement pour passer à "Next lig8" ?

vgendron · 23 Janvier 2023

Bonjour à tous

le Exit for permet de sortir de la boucle DANS laquelle il est inscrit

VB:

for i=1 to 10
     for j= 2 to 20
         if test then exit for 'sortie de la boucle for j
    next j

   'reprise du code suite au exit for
next i

sebastien450 · 23 Janvier 2023

Merci à vous.
Afin d'approfondir vous auriez peut être la solution pour aller chercher la date en feuil1.
A chaque fois que je tombe sur un Ofs en feuil1, j'aimerais la date exacte mais comme les cellules de la lignes 1 sont fusionnées, il faut que je recule jusqu'à tomber sur une date.
C'est lourd et peu efficace...

VB:

                                        For c3 = c2 To c2 - 24 Step -1 ' je vais donc lancer boucle col -1 jusqu'a -24 pour ma date de démarrage
                                            If Feuil1.Cells(1, c3).Value <> "" Then Feuil8.Cells(Cel.Row, 15).Value = Feuil1.Cells(1, c3).Value:   Exit For
                                        Next c3 ' je viens de recopier la date début en feuil8 à partir du planning : exit sub

Bernard_XLD · 23 Janvier 2023

Re,

sebastien450 à dit:
aller chercher la date en feuil1.

pas besoin de boucle, on récupère la valeur de la cellule 1 de la plage fusionnée à laquelle appartient la cellule cible

VB:

Feuil8.Cells(Cel.Row, 15).Value = Feuil1.Cells(1, c2).MergeArea(1).Value

en exemple, positionnez vous en ligne 5 du planning et lancez ce code, cela vous renverra la valeur de la cellule contenant la date pour chaque colonne concernée.

Code:

Sub Trouver_Date()
MsgBox ActiveCell.Offset(-5, 0).MergeArea(1).Value
End Sub

Cordialement, @+

sebastien450 · 24 Janvier 2023

Merci pour tout.

Pour information je viens de finaliser le code qui est plus rapide.
Ce qui pose "soucis" c'est que sur mon tableau 1 (au niveau de pas de 8) je balaye systématiquement des milliers de colonnes alors que parfois sur la ligne 8 mon range est de 3000=>3500. Sur la ligne 16 c'est 3000=> 5000. Sur la ligne 24 c'est 3000=>3400 ect ect.
je met le code complet pour les curieux.

VB:

Application.ScreenUpdating = False: Application.Calculation = xlManual: Application.EnableEvents = False    ' ca va aller plus vite ainsi

Range("DONNEES[[N°OF]:[ALLOCATION?]]").ClearFormats ' supprime les mises en forme
Fin = Feuil1.Cells(5, Cells.Columns.Count).End(xlToLeft).Column 'nb de colonne en feuil1
nb8 = Feuil8.Range("A65536").End(xlUp).Row: 'nb ligne tableau feuil8
Dim jour As Variant
For R = 4 To Feuil1.Cells(5, Fin).End(xlToLeft).Column ' Sur toute les colonnes je cherche la colonne correspondante date du jour
If Feuil1.Cells(1, R).Value = CDate(Year(Now) & "/" & Month(Now) & "/" & Day(Now)) Then jour = R: Exit For ''date du jour
Next R


Feuil8.Range("C2").ListObject.QueryTable.Refresh BackgroundQuery:=False ' Maj donnée feuil8
Feuil8.Range("DONNEES[[CHARGE ANNEE]:[TEXTE]]").Cut Destination:=Feuil8.Range("S2") 'je dois réorganiser mes colonnes issues de la macro

Feuil1.Activate 'je suis obilgé d'activer la feuil1 pour ne pas avoir d'erreur 'hypertexte
Set plage = Feuil1.Range(Cells(6, jour), Cells(214, Feuil1.Cells(5, Fin).End(xlToLeft).Column)) ' ma position de départ de mon tableau en ligne et colonne (i = ligne) et j = colonne
ncol = plage.Columns.Count
Tablo = plage

Dim Tablo2Ref As Range, Tablo2Val, Tablo2Cible
Set Tablo2Ref = Feuil8.Range(Feuil8.Cells(2, 1), Feuil8.Cells(nb8, 18)) ' mon tableau en feuil8 de la colonne 1 à 18
Tablo2Val = Tablo2Ref.Value
Tablo2Cible = Feuil8.Range(Feuil8.Cells(2, 1), Feuil8.Cells(nb8, 1)).Value

For lig8 = LBound(Tablo2Val, 1) To UBound(Tablo2Val, 1)  'MsgBox "ma cible " & Feuil8.Cells(lig8 + 1, 1).Value    ' de ma cellule début tableau feuil8 à la fin
            For i = 1 To UBound(Tablo) Step 8
                For J = 1 To ncol
                        If UCase(Tablo(i, J)) = Tablo2Cible(lig8, 1) Then

                                Tablo2Val(lig8, 15) = Feuil1.Cells(1, J + (jour - 1)).MergeArea(1).Value ' date début planning comment avoir la date sans reculer !
                                dur = Application.WorksheetFunction.Round((Feuil8.Cells(lig8 + 1, 7).Value * 1.1), 0) 'durée de mon of pour le décalage des colonnes
                                Tablo2Val(lig8, 16) = Feuil1.Cells(1, J + (jour - 1) + dur).MergeArea(1).Value ' date fin planning comment avoir la date sans reculer !
                                Feuil8.Hyperlinks.Add Anchor:=Feuil8.Cells(lig8 + 1, 1), Address:="", SubAddress:="Planning!" & Feuil8.Cells(i + (6 - 1), J + (jour - 1)).Address ' lien hypertetxe
                                Tablo2Val(lig8, 18) = "PLANIFIE": 'j'écris sur la colonne n°18
                                'ctrl allocation
                                If Feuil8.Cells(lig8 + 1, 31).Value >= 3 Then ' si sur la feuil8 des allocations je toruve une valeur de >=3
                                    Feuil1.Cells(i + (6 - 1), J + (jour - 1)).Interior.Color = RGB(0, 255, 204): Feuil1.Cells(i + (6 - 1), J + (jour - 1)).Font.Bold = True: Exit For ' je colore en feuil1 puis je sort
                                    Else 'colorie sur la feuille planning et mise en gras
                                    Feuil1.Cells(i + (6 - 1), J + (jour - 1)).Interior.Color = RGB(255, 255, 255): Feuil1.Cells(i + (6 - 1), J + (jour - 1)).Font.Bold = False: Exit For 'remet a blanc et pas gras
                                End If

                        End If
                Next J
                'If Tablo2Val(lig8, 1) = "PLANIFIE" Then Exit For
            Next i
Next lig8

Tablo2Ref.Value = Tablo2Val
 
Application.ScreenUpdating = True: Application.Calculation = xlManual: Application.EnableEvents = True

sebastien450 · 13 Février 2023

Bonjour,
je reviens vers vous car je m'aperçoit que le code est encore relativement lent.
En effet 2 étapes sont longues :

VB:

                                If Feuil8.Cells(lig8 + 1, 31).Value >= 3 Then ' si sur la feuil8 des allocations je toruve une valeur de >=3
                                    Feuil1.Cells(i + (6 - 1), J + (jour - 1)).Interior.Color = RGB(0, 255, 204): Feuil1.Cells(i + (6 - 1), J + (jour - 1)).Font.Bold = True: Exit For ' je colore en feuil1 puis je sort
                                    Else 'colorie sur la feuille planning et mise en gras
                                    Feuil1.Cells(i + (6 - 1), J + (jour - 1)).Interior.Color = RGB(255, 255, 255): Feuil1.Cells(i + (6 - 1), J + (jour - 1)).Font.Bold = False: Exit For 'remet a blanc et pas gras
                                End If

Et dans un second temps je balaye des miliers de colonnes sur ma plage

Code:

Set plage = Feuil1.Range(Cells(6, jour), Cells(214, Feuil1.Cells(5, Fin).End(xlToLeft).Column)) ' ma position de départ de mon tableau en ligne et colonne (i = ligne) et j = colonne

Alors que en réalité, beaucoup sont vides...

XL 2019 C'est lent mais alors lent

sebastien450

XLDnaute Occasionnel

vgendron

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

sebastien450

XLDnaute Occasionnel

Pièces jointes

Bernard_XLD

XLDnaute Barbatruc

Bernard_XLD

XLDnaute Barbatruc

sebastien450

XLDnaute Occasionnel

vgendron

XLDnaute Barbatruc

sebastien450

XLDnaute Occasionnel

Bernard_XLD

XLDnaute Barbatruc

sebastien450

XLDnaute Occasionnel

sebastien450

XLDnaute Occasionnel

Discussions similaires