Copie de données avec faible temps exécution

Le 14/08/2015 à 09:27

Bonjour tout le monde et bon vendredi !

Aujourd'hui je me tourne une fois de plus vers vous car je suis de nouveau confronté à un léger soucis.

J'explique ma situation:

J'ai un classeur "source" qui contient une matrice, cette même matrice est alimenté par une base de donnée Access. La base Access est mise à jour quotidiennement via une taches planifié qui lance une macro.

Voici à quoi il ressemble:

src

De l'autre coté j'ai un classeur "Destination", vous l'aurez compris, mon but est de prendre des valeurs de ma matrice dans mon classeur source pour les copier dans mon classeur destination. Sachant que la matrice source se met à jours régulièrement, elle est donc soumise à des modifications et sa taille varie en fonction des données qui la composent.

Par conséquent avant même de copier mes données je fais en sorte de récupérer mes entêtes, pour avoir un résultat identitique dans mon classeur destination.

Voici à quoi il ressemble:

dest

Je joint à ce message le code ma macro qui gére justement la copie de mes données dans le classeur destination

Sub CopieValeurMat()
'Déclaration de variables
Dim i, j, m, x, y As Integer
Dim nomprod As String
'Déclaration feuilles
Set fds = ThisWorkbook.Sheets("prep")
    dlt = fds.Cells(fds.Rows.Count, 1).End(xlUp).Row 'dernière ligne de fds
    dlt = dlt - 3 'Colonne noms des produits

    PathName = "C:\Users\seyahi\Desktop\PurgeTransfert\Presentation\"
    Filename = "CalculDesCommunsUploadDV.xlsm"
    Set wbs = Workbooks.Open(Filename:=PathName & Filename)
    Set ws = wbs.Sheets("MatricComposition")
    dlm = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
    dlm = dlm - 1
    DerniereColonne = ws.Cells(2, ws.Rows.Count).End(xlToRight).Column
    DerniereColonne = DerniereColonne - 1

'Copie des ref composants
Range(ws.Cells(2, 3), ws.Cells(2, DerniereColonne)).Select
Selection.Copy
            fds.Range("B2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Application.CutCopyMode = False

For i = 3 To dlt
    nomprod = fds.Cells(i, 1).Value
    For j = 3 To dlm
        If nomprod = ws.Cells(j, 2).Value Then
            Range(ws.Cells(i, 3), ws.Cells(i, DerniereColonne)).Select
            Selection.Copy
            fds.Cells(i, 2).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Application.CutCopyMode = False
        End If
Next i

End Sub

Avez-vous des suggestion à me faire, soit concernant la méthode utilisé pour copier mes valeurs soit carrément dans la méthode que je met en oeuvre pour gérer ma situation.

  • J'ouvre mon fichier source
  • Je récupère les valeurs dans mon fichier destination colonne "A"
  • Je vais interroger mon fichier source pour trouver la ligne correspondante
  • Je récupère mes données et je les colle dans mon fichier destination

L'objectif principal ici est la rapidité d’exécution! La mise en forme n'est pas importante. Actuellement mon code ne fonctionne pas.

Le 14/08/2015 à 10:25

Bonjour,

Difficile de tester le code suivant faute de supports, mais j'ai simplement remplacé les copies par une autre méthode. Par expérience, je sais que ça fait gagner du temps d'exécution. Adapte-le et après test dis-nous si ça marche.

    Sub CopieValeurMat()
    'Déclaration de variables
    Dim i, j, m, x, y As Integer
    Dim nomprod As String
    'Déclaration feuilles
    Set fds = ThisWorkbook.Sheets("prep")
    dlt = fds.Cells(fds.Rows.Count, 1).End(xlUp).Row 'dernière ligne de fds
    dlt = dlt - 3 'Colonne noms des produits

    PathName = "C:\Users\seyahi\Desktop\PurgeTransfert\Presentation\"
    Filename = "CalculDesCommunsUploadDV.xlsm"
    Set wbs = Workbooks.Open(Filename:=PathName & Filename)
    Set ws = wbs.Sheets("MatricComposition")
    dlm = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row - 1
    DerniereColonne = ws.Cells(2, ws.Rows.Count).End(xlToRight).Column - 1

    'Copie des ref composants
    Range(ws.Cells(2, 3), ws.Cells(2, DerniereColonne)).Copy Destination:=fds.Range("B2")
    For i = 3 To dlt
        nomprod = fds.Cells(i, 1).Value
        For j = 3 To dlm
            If nomprod = ws.Cells(j, 2).Value Then
                Range(ws.Cells(i, 3), ws.Cells(i, DerniereColonne)).Copy Destination:=fds.Cells(i, 2)
            End If
        Next j
    Next i
    End Sub
Le 14/08/2015 à 10:36

Bonjour Raja,

Merci pour ton implication dans cette discussion.

J'ai mis à jour mon code est il fonctionne:

Sub CopieValeurMat()

'Déclaration de variables
Dim i, j, m, x, y As Integer
Dim nomprod As String

'Déclaration feuilles
Set fds = ThisWorkbook.Sheets("prep")
    'dlt = fds.Cells(fds.Rows.Count, 1).End(xlUp).Row 'dernière ligne de fds
    'dlt = dlt - 3 'Colonne noms des produits

    'Ouverture de la matriceComposition
    PathName = "T:\Donnees produits\"
    Filename = "CalculDesCommuns.xlsm"
    Set wbs = Workbooks.Open(Filename:=PathName & Filename)
    Set ws = wbs.Sheets("MatricComposition")
    dlm = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
    dlm = dlm - 1
    derniereColonne = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column - 1
    'derniereColonne = derniereColonne - 1

'Copie des ref composants
'Set ref = ws.Range(ws.Cells(2, 1), ws.Cells(dls, 1))
ws.Range(ws.Cells(2, 3), ws.Cells(2, derniereColonne)).Copy
            fds.Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Application.CutCopyMode = False

fds.Range(fds.Cells(3, 2), fds.Cells(72, 1561)).ClearContents
'Copie des valeurs les unes après les autres
For i = 3 To 72
    nomprod = fds.Cells(i, 1).Value
    For j = 3 To dlm
        If nomprod = ws.Cells(j, 2).Value Then
            Range(ws.Cells(i, 3), ws.Cells(i, derniereColonne)).Copy
            fds.Cells(i, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Application.CutCopyMode = False
        End If
    Next j
Next i

wbs.Close SaveChanges:=False
Application.ScreenUpdating = False

End Sub

Je vais essayer avec la solution que tu propose.

Je te tiens informé.

J'ai testé, je gagne en temps d'exécution grâce a tes modifications, le fait de ne pas rafraîchir l'écran me permet de gagner en temps d'exécution également.

J'ajoute également que tes modifs permettent de simplifier le code, donc bon a prendre.

Le seul Hick, c'est que la copie des données, copie également la mise en forme. Ce que je ne souhaite pas. Alors si quelqu'un peut proposer une solution à ce problème ..??

Dernière version de code:

Sub CopieValeurMat()
'Déclaration de variables
Dim i, j, m, x, y As Integer
Dim nomprod As String

'Déclaration feuilles
Set fds = ThisWorkbook.Sheets("prep")
    'dlt = fds.Cells(fds.Rows.Count, 1).End(xlUp).Row 'dernière ligne de fds
    'dlt = dlt - 3 'Colonne noms des produits

    'Ouverture de la matriceComposition
    PathName = "T:\Donnees produits\"
    Filename = "CalculDesCommuns.xlsm"
    Set wbs = Workbooks.Open(Filename:=PathName & Filename)
    Set ws = wbs.Sheets("MatricComposition")
    dlm = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
    dlm = dlm - 1
    DerniereColonne = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column - 1
    'derniereColonne = derniereColonne - 1

'Copie des ref composants
ws.Range(ws.Cells(2, 3), ws.Cells(2, DerniereColonne)).Copy Destination:=fds.Range("B2")
fds.Range(fds.Cells(3, 2), fds.Cells(72, 1561)).ClearContents 'Suppression ancienne données

'Copie des valeurs les unes après les autres
For i = 3 To 72
    nomprod = fds.Cells(i, 1).Value
    For j = 3 To dlm
        If nomprod = ws.Cells(j, 2).Value Then
            Range(ws.Cells(i, 3), ws.Cells(i, DerniereColonne)).Copy Destination:=fds.Cells(i, 2)
        End If
    Next j
Next i

wbs.Close SaveChanges:=False
Application.ScreenUpdating = False
End Sub
Le 14/08/2015 à 11:20

Re,

OK. Il me semble que tu avais dit ça :

iliasse a écrit :

L'objectif principal ici est la rapidité d’exécution! La mise en forme n'est pas importante. Actuellement mon code ne fonctionne pas.

.

C'est pour cette raison, ma solution n'a pas tenu compte de la mise en forme. Attends un peu, la solution viendra.

Le 14/08/2015 à 11:43

Oui effectivement,

Je me suis peut être mal exprimé, j'aurais du dire : La mise en forme est à négliger, autrement dit, ne pas la copier...

Penses-tu que ton code est modifiable pour ne pas prendre en compte la mise en forme ?

Le 14/08/2015 à 11:58

Bonjour,

avec un classeur de travail réduit on pourrait tester des trucs...

eric

Le 14/08/2015 à 12:02

Re, Salut eriic,

OK. Pas de soucis. Essaye de remplacer la partie du code comme suivant, et surtout adapte-le à ta solution. La logique est de récupérer les valeurs venant de classeur source :

'Copie des valeurs les unes après les autres
For i = 3 To 72
    nomprod = fds.Cells(i, 1).Value
    For j = 3 To dlm
        If nomprod = ws.Cells(j, 2).Value Then
            Range(fds.Cells(i, 2), fds.Cells(i, DerniereColonne - 1)).Value = Range(ws.Cells(i, 3), ws.Cells(i, DerniereColonne)).Value
        End If
    Next j
Next i

Teste le résultat surtout.

Le 14/08/2015 à 12:06

Je vous envoie tout ça,

Fichier Destination: https://www.cjoint.com/c/EHokfE4b3xM

Fichier Source: https://www.cjoint.com/c/EHokfYXlpNM

Le 14/08/2015 à 12:56

Le chemin du fichier source est à adapter en fonction de l'organisation de vos répertoires.

Le 14/08/2015 à 15:57

J'ai tenté en filtrant le TCD pour ne faire qu'un seul copier-coller mais l'application des filtres est plus longues, donc pas mieux.

Pour éviter les formats essaie avec :

Range(ws.Cells(i, 3), ws.Cells(i, DerniereColonne)).Copy
fds.Cells(i, 2).PasteSpecial Paste:=xlPasteValues

eric

Le 17/08/2015 à 09:08

Re Eric,

Oui entre temps j'avais trouvé cette formule qui permet de saisir seulement les valeurs. Concernant les filtres sur le TCD je peux voir ce que tu as fais ?

Peut être que même si le temps d’exécution est un peu long, cela pourra éventuellement convenir, à voir ..

En attente d'une réponse. merci

Le 17/08/2015 à 10:12

Bonjour,

Non je n'ai pas gardé, ce n'était pas rentable.

Et pour quelques dizaines de lignes, même s'il y a une solution plus rapide tu ne gagneras que qq 1/10e de seconde.

eric

Le 17/08/2015 à 10:34

ok,

Si on compare les deux méthodes:

  • Copier les lignes du TCD en récupérant seulement les valeurs
  • Filtrer le TCD puis copier les lignes correspondante

Pour un total de 70 lignes dans les deux cas. Tu estimerais à combien de temps l'écart de temps entre ces deux méthodes ?

Le 17/08/2015 à 12:11

Filtrer tu y perds, les masquer pour ne faire qu'une copie unique tu y gagneras peut-être mais ça sera peanuts.

Il met combien de temps actuellement ? Pas grand chose je suppose, inutile de se prendre la tête.

eric

Le 17/08/2015 à 12:58

Oui actuellement le temps d’exécution est presque négligeable.

Je me demandais si on ne pouvais pas trier pour la raison suivante:

Sur ma matrice "dynamique" esclave de ma base, j'effectue certains calculs.

Si la matrice est filtré ou pas, les résultats de ces calculs ne sont pas les mêmes.

Je me disais que si l'on peut la filtrer simplement et rapidement via un petit formulaire dans lequel on entrerais nos produits. Cela permettrait de ne pas avoir a recalculer les différentes valeurs et de les récupérer tout simplement via un copier-coller après que le filtre soit actif...

Enfin cette étape je l'envisageais dans un futur plus ou moins lointain, mais actuellement je me dis que si on peut faire d'une pierre deux coups, alors WHYNOT.

PS: "peanuts" qu'entends-tu par là ?

Le 17/08/2015 à 16:05

peanuts = des cacahuètes...

Pour le reste c'est une toute autre question que tu poseras dans une nouveau fil le moment venu.

Mais ce n'est avec des précisions comme certains calculs... que l'ont peut y répondre.

eric

Le 17/08/2015 à 16:13

Je connaissais la traduction de peanuts, mais pas l'expression avec laquelle tu l'utilise.. bref

Quand je parle de "certains calculs" je fais référence à la première colonne de ma feuille "matriccomposition" (CF billet #1)..

Rechercher des sujets similaires à "copie donnees faible temps execution"