Excel code VBA trop lent

Puis je pense que ma logique pour cette partie là n'étais pas bonne de base

Désolé, je pensais avoir corrigé ... mais en effet j'avais cela mais le fichier était devenu pollué par mon erreur que je n'avais pas pu retesté ...je vais recharger l'original.

Pour la logique, je n'ai pas trop réfléchi, mais je n'ai pas instantanément trouvé mieux.

Bonjour à tous,

@Steelson : J'ai suivi le sujet. Le code était long, c'est pas évident d'arriver à l'optimiser comme tu l'as fait. Bravo !

@despekill : Je crois que le problème vient juste du application.transpose. En l'enlevant, ça marchera certainement. Je propose de factoriser la dernière partie du code (j'essaie de m'adonner à ce petit exercice ces derniers temps). Ca ne rendra pas forcément le code plus rapide mais peut-être plus clair.

Voici donc un essai en espérant avoir compris :

Sub Remplacement(NomFeuille$, colSource&, colDest&)
'ALIMENTATION TABLEAU REMPLACEMENT - MOTS A REMPLACER EN A, NOUVEAUX MOTS EN B
With Sheets("frns") '<<< en dur
    dl = .Cells(.Rows.Count, 1).End(xlUp).Row
    arrRmplt = .Range("A1:B" & dl).Value '<<< en dur
End With
'POUR EVITER LES REMPLACEMENTS INDESIRABLES
for i = lbound(arrRmplt) to ubound(arrRmplt)
    t(i, 1) = "_" & t(i, 1) & "_"
next i
'Alimentation tableau données (colonne source) - Boucle de remplacement sur chaque item - Collage (colonne destination)
With Sheets(NomFeuille)
    dl = .Cells(.Rows.Count, 1).End(xlUp).Row
    arrData = .Cells(1, colSource).Resize(dl).Value
    For x = LBound(arrData) + 1 To UBound(arrData)
        For p = LBound(arrRmplt) To UBound(arrRmplt)
            arrData(x, 1) = Replace("_" & arrData(x, 1) & "_", arrRmplt(p, 1), arrRmplt(p, 2))
        Next p
    Next x
    .Cells(1, colDest).Resize(UBound(arrData)) = arrData
End With
End Sub

Cette macro paramétrée est alors à utiliser (exécuter) ainsi :

Sub MacroNew()

depart = Timer

    Worksheets("cmd").Unprotect
    Worksheets("cmd2").Unprotect
    Worksheets("art").Unprotect

' recopie et tri des cmd_frns dans cmd
    Worksheets("cmd").Range("A1:CC1000").ClearContents

    Sheets("cmd_frns").Cells.AdvancedFilter Action:=xlFilterCopy, CriteriaRange _
    :=Sheets("filtre").Rows("1:2"), CopyToRange:=Sheets("cmd").Range("A1"), Unique:=False

    derL = Sheets("cmd").Cells(Rows.Count, 1).End(xlUp).Row
    ActiveWorkbook.Worksheets("cmd").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("cmd").Sort.SortFields.Add Key:=Range("C2:C" & derL), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("cmd").Sort
        .SetRange Range("A1:BW" & derL)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Debug.Print 1, Timer - depart

' remplacement des termes
Dim Data, dico As Object

    Data = Sheets("cmd").Range("H2:H" & derL)
    Set dico = CreateObject("Scripting.Dictionary")
    dico(51822) = "CDA"
    dico(51882) = "Verrou"
    dico(51884) = "Stock"
    dico(50049) = "Dépa"
    dico(51788) = "Intrusion"
    dico(51821) = "Incendie"
    On Error Resume Next
    For x = 1 To UBound(Data)
        Data(x, 1) = dico(Data(x, 1))
    Next
    On Error GoTo 0
    Sheets("cmd").Range("H2").Resize(UBound(Data), 1) = Data

Debug.Print 2, Timer - depart
'**************ICI******************
Remplacement "cmd", 12, 80 '<<<<
Remplacement "cmd", 6, 79 '<<<<
'***********************************
Debug.Print 3, Timer - depart

    Worksheets("art").Range("A1:BK1000").ClearContents
    Sheets("art_cmd").Cells.AdvancedFilter Action:=xlFilterCopy, CriteriaRange _
    :=Sheets("filtre").Rows("4:5"), CopyToRange:=Sheets("art").Range("A1"), Unique:=False

Debug.Print 4, Timer - depart

        Dim Mot, Achever3, Test1, Date4, Commande5, Type6 As String
        Dim Projet0 As String * 55
        Dim ref2 As String * 30
        Dim frns8 As String * 15
        Dim i As Integer
        Dim sepr As String

        sepr = Chr(10)
        Sheets("cmd").Select
        last_row = Worksheets("cmd").Cells(Rows.Count, 1).End(xlUp).Row
        Data = Sheets("cmd").Range(Cells(1, 1), Cells(last_row, 80))
        For i = 2 To UBound(Data)
            ref2 = Data(i, 13)          'Range("M" & i).Value
            Achever3 = Data(i, 80)      'Range("CB" & i).Value
            Date4 = Data(i, 4)          'Range("D" & i).Value
            Commande5 = Data(i, 3)      'Range("C" & i).Value
            Type6 = Data(i, 8)          'Range("H" & i).Value
            Test1 = Data(i, 77)         'Range("BY" & i).Value
            Projet0 = Data(i, 78)       'Range("BZ" & i).Value
            frns8 = Data(i, 79)         'Range("CA" & i).Value
            Mot = "Projet : " & Test1 & " " & Projet0 & sepr & "Article commander le " & Date4 & sepr & "Nom : " & ref2 & sepr & "N° de commande : " & Commande5 & " " & " " & " " & "Achever : " & Achever3 & sepr & "Type : " & Type6 & " " & "Fournisseur : " & frns8
            Data(i, 78) = Mot           'Range("BX" & i).Value = Mot
        Next i
        Sheets("cmd").Cells(1, 1).Resize(UBound(Data), UBound(Data, 2)) = Data

    Sheets("vue").Activate
    Range("F2:F3").Select
    Selection.ClearContents
    Worksheets("cmd").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Worksheets("cmd2").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Worksheets("art").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Debug.Print 5, Timer - depart

End Sub

Je pense qu'il est possible de le faire aussi pour la partie Dico juste avant... Il y a encore des éléments en dur dans la macro Remplacement. L'idéal serait d'avoir "que" des variables pour qu'elle soit facilement réutilisable.

Il pourrait être pratique d'avoir une macro pour le tri aussi, on crée ainsi des sous-parties de l'exécution qui rendent le tout plus lisible et plus facilement maintenable.

Cdlt,

Remarque, c'est dangereux, heureusement qu'ils sont dans cet ordre là, si tu avais mis le 14 avant le 144 tu n'aurais jamais pu traduire le 144 qui aurait été masqué.

Steelson, oui l'ordre est fait exprès j'ai eu le soucis c'est la seul solution que j'ai trouver

Merci 3GB

3GB a écrit :

@despekill : Je crois que le problème vient juste du application.transpose. En l'enlevant, ça marchera certainement. Je propose de factoriser la dernière partie du code (j'essaie de m'adonner à ce petit exercice ces derniers temps). Ca ne rendra pas forcément le code plus rapide mais peut-être plus clair.

Je pense qu'il est possible de le faire aussi pour la partie Dico juste avant... Il y a encore des éléments en dur dans la macro Remplacement. L'idéal serait d'avoir "que" des variables pour qu'elle soit facilement réutilisable.

Je cautionne entièrement le fait de mettre les valeurs de dico dans une feuille, là j'avais traduit au plus près mais généralement je ne mets jamais les paramètres dans le code.

Et si cela fonctionne sans transpose, alors ok (j'avoue que je m'étais posé la question !!), donc je n'essaie pas de mon côté car je suis pris pour le moment !

Enfin, je suis quand même très inquiet pour la conversion des fournisseurs, cela peut déraper si l'ordre fait qu'un élément puisse être masqué par un autre nombre dont les chiffres sont inclus dans ledit nombre. Exemple 234 puis plus loin 12345, le 12345 ne sera jamais traduit car la partie centrale aura été déjà traduite.

despekill a écrit :

Steelson, oui l'ordre est fait exprès j'ai eu le soucis c'est la seul solution que j'ai trouver

Il faudrait y ajouter un espace devant ou derrière.

Oui, c'est normal, tu peux pas tout faire en même temps, à la fois traduire et optimiser et à la fois factoriser. Sans tout ce que tu as fait, je n'aurais pas pu , j'ai saisi la brèche une fois le code clarifié !

Le transpose, je n'ai pas testé mais on prend une colonne qu'on restitue dans une colonne. Donc je crois que c'est ça. Et ça semble confirmé par le fait que la première valeur du tableau apparaisse dans chaque cellule.

Pour cette histoire de code fournisseur, en effet, c'est pas l'idéal. Il est possible de créer une boucle intermédiaire afin de transformer chaque code X en _X_ par exemple dans le tableau datafrns. Ca limiterait la casse.

EDIT : J'ai modifié mon code pour tenir compte de ce souci.

super, nickel

je te passe le relais

Bonjour 3GB,

Je tiens compte de vos remarques, merci de m'aider à m'améliorer.

Je regarde un peu de mon coté et j'attend votre retour sur le code.

J'ai l'impression que Steelson a déjà tout fait au niveau de la vitesse d'exécution. Je n'ai pas vraiment d'expérience à ce niveau-là, je voulais seulement scinder le code un petit peu, mais je ne pense pas pouvoir le rendre plus rapide qu'il n'est déjà.

Chez moi, j'ai divisé par 10 le temps d'exécution.

Oui, j'ai l'impression que c'est bon là !

Tu as du mérite d'en être venu à bout !

@despekill : Est-ce que tu as pu essayer ?

Bonjour,

Comment 3GB s'est débarrassé du relais !

Dis pas de sottise JoyeuxNoel ! Tu es taquin toi

Si jamais optimiser les programmes et gagner du temps d'execution c'est une addiction chez vous les gars, j'ai un topic qui est toujours sans réponses hein..

A prendre au premier degrés, je ne suis pas dans l'urgence et n'éxige rien bien sûr

Gabin37 a écrit :

j'ai un topic qui est toujours sans réponses hein..

on peut accélérer un code VBA, on ne peut pas accélérer une requête web et interagir avec la vitesse d'accès internet !

et avec 400 requêtes, tu risques une fermeture d'accès temporaire au site, tu me diras, avec un AK-47 dans la liste, ils te laissent entrer

et puis je n'ai pas bien compris tes codes espoir et l'autre au nom fleuri

Tkt pas Steelson, je comprend le problème d'une requête Web, en fait j'esperais plutot avoir juste un Userform de chargement 0% -> 100% qui me permette de faire tourner le prog sans que cela crash et sans le Excel ne répond pas

Enfin bref, on ne vas pas en discuter ici

En tout cas, j'ai suivit de loin par curiosité c'est vrai que tu as fait du beau boulot Steelson ici bien joué

Salut Gabin,

Il passe pas inaperçu ton on error ...

Je n'ai aucune certitude mais est-ce que tu as essayé de temporiser avec un application.wait now + timevalue("00:00:01") dans ta boucle ? Ca rendra sûrement pas le code plus rapide mais peut-être que ça laissera la bête souffler un peu.

Pourquoi pas, je vais tester. quitte à perdre quelques secondes mais pas faire planter Excel ca me va.

On risque de se faire gronder si on parle d'autre chose ici

Par contre, si mes calculs sont bons, ça te fera perdre 400 secondes ! Je crois que tu peux diviser le timevalue (par 5 par exemple).

Peut-être avec un sleep sinon, qui gère les millisecondes...