Copier-coller lent

[Holeshotman]

Bonjour à tous,

Je fais appel à vous, car j'ai réalisé un mini programme qui me permet de copier-coller des données d'une feuille à une autre, et je ne suis pas totalement convaincu par la vitesse d'exécution, assez lente.

Je vous joins en premier lieu un fichier simplifié pour faciliter la compréhension du problème.

Sur la première feuille, nommée "BdD", j'ai mes données. A une référence d'outil est associée une et une seule référence de plan. La colonne nommée doublons me permet de faire des tris, elle ne nous intéresse pas spécialement dans le cadre du problème rencontré.

Sur la seconde feuille, nommée "Synthèse", j'ai un TCD. J'y ai ajouté une colonne nommée "plan outil" dans laquelle je viens coller les liens hypertextes associés aux références des outils (liens hyp. qui se trouvent sur la première feuille, en colonne E).

La macro compare les deux colonnes dans lesquelles sont présentes les références des outils (colonne E de la feuille "Synthèse" et colonne D de la feuille "BdD") et associe en colonne D de la feuille "Synthèse" la référence de plan associée.

Le problème est lié au fait que la macro parcoure pour chaque référence la totalité de la plage "Référence outil" de la feuille "BdD". Il faudrait que le copier-coller s'effectue sur la première égalité rencontrée et que le parcours de la colonne s'arrête à ce moment là. (sur le modèle simplifié joint, c'est assez rapide, mais le modèle réel contient beaucoup plus de données ...).

Merci par avance pour votre aide !

 

[Paf]

Re : Copier-coller lent

bonjour

Il faudrait que le copier-coller s'effectue sur la première égalité rencontrée et que le parcours de la colonne s'arrête à ce moment là.

Dans la boucle For Each Y In PlageDeComp il faudrait rajouter Exit For juste avant le End If

Sinon pour une vitesse d'exécution accrue, il faudrait passer par des tableaux (au sens VBA)

A+


Edit : Bonjour vgendron

 

[vgendron]

Re : Copier-coller lent

Hello Hole and Paf ;-)

Paf a été plus rapide que moi.: j'allais dire exactement la meme chose..
mais comme j'ai fait la modif et le copier coller de ton code. je vais au bout ;-)

Sub InsertLien()

Dim PlageRef, PlageDeComp, X, Y As Variant
Dim DerLigne1, DerLigne2 As Long

DerLigne1 = Workbooks("MODELE").Worksheets("Synthèse").Range("E" & Rows.Count).End(xlUp).Row
DerLigne2 = Workbooks("MODELE").Worksheets("BdD").Range("D" & Rows.Count).End(xlUp).Row

Set PlageRef = Workbooks("MODELE").Worksheets("Synthèse").Range("E5:E" & DerLigne1)
Set PlageDeComp = Workbooks("MODELE").Worksheets("BdD").Range("D2:D" & DerLigne2)

For Each X In PlageRef
   For Each Y In PlageDeComp
      If X = Y Then
      Y.Offset(0, 1).Copy
      X.Offset(0, -1).PasteSpecial Paste:=xlPasteAllExceptBorders, operation:=xlNone, skipblanks:=False, Transpose:=False
      With ActiveCell
      .Interior.ColorIndex = xlColorIndexNone
      .Font.Size = 10
      .Font.Name = "Calibri"
      .Font.Color = RGB(161, 6, 132)
      .Font.Bold = True
      End With
      Exit For
      End If
   Next Y
Next X

End Sub

 

[vgendron]

Re : Copier-coller lent

sinon. tu peux aussi tester avec la fonction Find..

Sub InsertLien()

Dim PlageRef, PlageDeComp, X, Y As Variant
Dim DerLigne1, DerLigne2 As Long

DerLigne1 = Workbooks("MODELE.xlsm").Worksheets("Synthèse").Range("E" & Rows.Count).End(xlUp).Row
DerLigne2 = Workbooks("MODELE.xlsm").Worksheets("BdD").Range("D" & Rows.Count).End(xlUp).Row

Set PlageRef = Workbooks("MODELE.xlsm").Worksheets("Synthèse").Range("E5:E" & DerLigne1)
Set PlageDeComp = Workbooks("MODELE.xlsm").Worksheets("BdD").Range("D2:D" & DerLigne2)

For Each X In PlageRef
    Set c = PlageDeComp.Find(X)
    If Not c Is Nothing Then
        c.Offset(0, 1).Copy
        X.Offset(0, -1).PasteSpecial Paste:=xlPasteAllExceptBorders, operation:=xlNone, skipblanks:=False, Transpose:=False
        With ActiveCell
            .Interior.ColorIndex = xlColorIndexNone
            .Font.Size = 10
            .Font.Name = "Calibri"
            .Font.Color = RGB(161, 6, 132)
            .Font.Bold = True
        End With
    End If
Next X
End Sub

 

[vgendron]

Re : Copier-coller lent

ou encore; avec une "simple" formule
=DECALER(Tableau1[[#En-têtes];[Projet]];EQUIV(E5;Tableau1[Référence outils];0);2)