XL 2021 [RESOLU] Remplacer des formules pour du VBA

[Bloody_Toad]

Bonjour

Voilà mon fichier qui fonctionne pas mal, mais qui au fil de l'année s'alourdit et devient vraiment très lent. Je pense que la cause sont les formules de recherche en colonne G et J.

Je voudrais "si possible" faire une macro qui remplace ces formules.

Je joins mon fichier, il n’y a pas mal de formules et macro glanée par-ci par-là et modifiée à ma sauce "soyer indulgent". Je ne suis réellement pas très doué pour le VBA.

Merci

 

[sylvanu]

Bonjour Bloody_Toad,
Il est où le fichier ?

 

[Lolote83]

Bonjour,

Je joins mon fichier

mais ou est ce fameux fichier ???
@+ Lolote83

 

[Bloody_Toad]

Bonjour

Ça me dit que le fichier est trop volumineux, je n'avais pas fait attention. Désoler./ Je regarde ce que je peux faire pour l'alléger.

 

[sylvanu]

Une PJ doit être minimale, représentative, et anonyme.
Ne conservez que les infos utiles au problème, le reste n'a aucune importance.
Et une vingtaine de lignes est suffisant pour montrer comment remplacer des formules par leur équivalent VBA.

 

[Bloody_Toad]

Re bonjour

=SI(H11="";"";INDEX('N° d''affaires'!$B$2:$B$222;EQUIV(H11;'N° d''affaires'!$C$2:$C$222;0);1))
=SI(H11="";"";INDEX('N° d''affaires'!$B$2:$B$222;EQUIV(H11;'N° d''affaires'!$C$2:$C$222;0);1))
ce sont les formules qui je pense sont incriminées.

Qu'est qui fait que la feuille "N° d'affaires "pèse à elle toute seule 19Mo même quand j'efface tous (formule et mise en forme conditionnelle et texte)??

Du coup si j'envoie mon fichier sans la feuille "N° d'affaire" la référence de la formule a en erreur "#REF!! normal !
J'ai supprimé la feuille en question et copier-coller les valeur et je me suis aperçu que si je colle la mise en forme , je retourne à 20MO le fichier. Là, je crois que je me disperse.

 

[Bloody_Toad]

Re-re-bonjour
J'ai réussi à nettoyer la feuille qui faisais 19Mo je vous joint mon fichier
Merci et encore désolé

 

[sylvanu]

Bonjour,
Un essai en PJ avec une macro unique dans Thisworkbook.
Elle s'active automatiquement lorsqu'on change une valeur d'une cellule quelconque dans n'importe quelle feuille.

Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If [F1] <> "FEUILLE DE POINTAGE" Then Exit Sub ' On n'est pas sur une feuille de pointage, donc on sort
    On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [H11:H39]) Is Nothing Then         ' Si cellule remplie en colonne G
        With Sheets("N° d'affaires")
            DL = .Cells(Cells.Rows.Count, "A").End(xlUp).Row    ' Dernière ligne
            Tablo = .Range("B14:F" & DL)                        '¨Pays Capitales dans Tablo
        End With
        Ligne = Target.Row                                      ' N° ligne concernée
        If Cells(Ligne, "H") = "" Then                          ' Si H vidée
            Cells(Ligne, "G") = ""                              'on vide G
            Cells(Ligne, "J") = ""                              'on vide J
        Else
            Affaire = "": Responsable = ""                      ' On recherche la capitale concernée
            For i = 1 To UBound(Tablo)
                If Tablo(i, 2) = Target Then                    ' Si on trouve on mémorise Capitale et Resp.
                    Affaire = Tablo(i, 1): Responsable = Tablo(i, 4)
                    Exit For
                End If
            Next i
            Application.DisplayAlerts = False
            Cells(Ligne, "G") = Affaire                     ' On écrit dans les cellules
            Cells(Ligne, "J") = Responsable
        End If
    End If
Fin:
Application.DisplayAlerts = True
End Sub

La seconde macro ne sert à rien, elle ne fait qu'effacer tous les tableaux de toutes les feuilles de pointage.
Un stage d'amaigrissement peut on dire. Ainsi après le fichier est propre.

 

[sylvanu]

Ou beaucoup plus simple après réflexion, il suffit de mettre les formules dans les cellules G et J de la ligne concernée puis de faire un copier coller valeurs :

Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If [F1] <> "FEUILLE DE POINTAGE" Then Exit Sub ' On n'est pas sur une feuille de pointage, donc on sort
    On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [H11:H39]) Is Nothing Then         ' Si cellule remplie en colonne G
        Application.DisplayAlerts = False
        L = Target.Row  ' N° ligne concernée
        Formule = "=SI(H" & L & "="""";"""";INDEX('N° d''affaires'!$B$2:$B$222;EQUIV(H" & L & ";'N° d''affaires'!$C$2:$C$222;0);1))"
        Cells(L, "G").FormulaLocal = Formule: Cells(L, "G") = Cells(L, "G").Value
        Formule = "=SI(H" & L & "="""";"""";INDEX('N° d''affaires'!$F$2:$F$222;EQUIV(H" & L & ";'N° d''affaires'!$C$2:$C$222;0);1))"
        Cells(L, "J").FormulaLocal = Formule: Cells(L, "J") = Cells(L, "J").Value
    End If
Fin:
Application.DisplayAlerts = True
End Sub

 

[Bloody_Toad]

Sylvanu
Merci, Merci, merci beaucoup pour la rapidité c'est exactement ce que je voulais, ça marche impeccablement.
Je vais la copier dans mon fichier et voir si je gagne en rapidité.
Cordialement

 

[sylvanu]

La seconde PJ devrait un poil plus rapide.

Et passer la seconde macro sur votre fichier ( sauvegardé sous un autre nom ), sinon vos formules initiales resteront.

 

[Bloody_Toad]

Oui plus court en script et plus parlent pour moi, je ne savais pas que l'on pouvait écrire des formules dans le VBA.
Encore merci.

 

[Bloody_Toad]

Je reviens vers toi.
Juste pour info la seconde proposition avec les formules me limite à la ligne 222 et si je dépasse, je suis obligé de modifier la macro, alors qu'avec la première macro pas de limite. ;-)

 

[sylvanu]

Vous pouvez :
1- Utilisez la première version
2- Dans la 2eme version remplacer les 222 par 500 par ex, ou 1000. Cela ne changera guère le temps d'éxécution.

Question : avez vous vu une amélioration de la rapidité ?

 

[Bloody_Toad]

Je ne peux pas vous dire pour l'instant, je n'ai pas fini de tous remettre à jour sur mon planning 2023, j'ai modifié la macro " efface_tableau" pour que ça efface que les colonnes G et J et il faut que je revalide touuut les jours pour que la macro se lance. Je vous tiens au courant.
Question pour la macro avec les formules, on ne peut pas lui dire "va jusqu'à la dernière linge non vide ?"