Temps d'exécution trop long Résolu

Question

Bonjour,

J'ai créé un code qui fonctionne. Seul problème, il met presque 2H00 à s'exécuter !
Ce qui est beaucoup trop long.

J'ai un classeur. Dans ce classeur j'ai plusieurs feuilles mais ici seulement deux
nous intéresse.

Dans ces feuille, j'ai des colonnes, dont une dans la feuille "TXT" en F qui est une
colonne de concaténation et une autre dans la feuille "BASE" en Z qui est aussi
une colonne de concaténation.

Si les 2 colonnes de concaténations correspondent, la cellule en E de "TXT" se copie dans la
cellule en F de "BASE".

Il se peut qu'une valeur de concaténation de "TXT" correspondent à 2 valeurs de concaténation de la 
feuille "BASE".

La feuille "TXT" comporte environ 20 000 lignes, mais cela peut changer ..

Voici mon code :

Sub copie()Application.ScreenUpdating = FalseDim u as longDim j as longu = 2j = 2Do While Sheets("BASE").Cells(u, 1).Value <> ""If Sheets("BASE").Cells(u, 26).Value = Sheets("TXT").Cells(j, 6).Value ThenSheets("BASE").Cells(u, 6).Value = Sheets("TXT").Cells(j, 5).Valueu = u + 1j = 2Else: j = j + 1End IfIf Sheets("TXT").Cells(j, 1).Value = "" Then    j = 2    u = u + 1End IfLoop

Merci d'avance pour votre aide.

michel_m · Answer

bonjour

effectivement....
Mettrun extrait du  classeur -2000 à 3000 lignes- sans données confidentielles en pièce jointe sur https://www.cjoint.com/et coller le raccourci  par un clic droit sur le lien proposé dans le message de réponse 
Dans l’attente

Il se peut qu'une valeur de concaténation de "TXT" correspondent à 2 valeurs de concaténation de la 
feuille "BASE". 

on conserve les doublons ou non ?

gbinforme · Answer

Bonjour,

@michel_m : un grand coucou à toi

@siamens_duj : Je te propose de modifier ainsi ta macro 
Sub copie()
Dim u As Long
Dim j As Long
Dim tbb, tbt
Application.ScreenUpdating = False
    With Sheets("BASE")
        tbb = .Cells(1, 26).Resize(.Cells(Rows.Count, 26).End(xlUp).Row, 1).Value
    End With
    With Sheets("TXT")
        tbt = .Cells(1, 5).Resize(.Cells(Rows.Count, 6).End(xlUp).Row, 2).Value
    End With
    For u = 2 To UBound(tbb)
        For j = 2 To UBound(tbt)
            If tbb(u, 1) = tbt(j, 2) Then
                Sheets("BASE").Cells(u, 6).Value = tbt(j, 1)
                Exit For
            End If
        Next j
    Next u
Application.ScreenUpdating = True
End Sub

 
 Toujours zen
La perfection est atteinte, non pas lorsqu'il n'y a plus rien à ajouter, mais lorsqu'il n'y a plus rien à retirer.  Antoine de Saint-Exupéry

Temps d'exécution trop long

2 réponses

Discussions similaires

Newsletters