Optimisation code VBA

Le
Patrick BASTARD
Bonjour à toutes et tous.

Le code suivant fonctionne parfaitement.
Mais son exécution est très longue : 30 mn, montre en main, pour traiter
1886 lignes.
Auriez-vous une idée pour en accélérer l'exécution ?

D'avance, merci
***********************************************************
Sub Concaténère()

Application.ScreenUpdating = False
Dim a As Integer 'maxi : - 32768 à + 32767
Dim i As Integer
Dim j As Integer
Dim Nouveau

For a = 4 To Range("c32000").End(xlUp).Row
If Len(Cells(a, 3)) = 13 Then 'Trouve le premier guide
Nouveau = Cells(a, 3)
Exit For
End If
Next a
For i = 4 To Range("c32000").End(xlUp).Row
If Left(Cells(i, 3), 11) = Left(Nouveau, 11) Then
Cells(i, 3) = Nouveau 'Place le guide
Else
For j = i To Range("c32000").End(xlUp).Row
If Len(Cells(j, 3)) = 13 Then 'Trouve les autres guides
Nouveau = Cells(j, 3)
Cells(i, 3) = Nouveau
Exit For
End If
Next j
End If
Next i
End Sub
***********************************************************
--
Bien amicordialement,
P. Bastard

Avant d'imprimer ce mail, ayez une pensée pour les arbres.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Philippe.R
Le #4978191
Bonjour Patrick,
La seule piste qui me vienne à l'esprit est de passer en calcul manuel en
début de proc et de repasser en automatique à la fin ; surtout si tu as pas
de formule dans le classeur.
A ce sujet, est ce délibérément que tu ne réactive pas le rafraichissement
d'écran en fin de proc ?
--
http://www.excelabo.net/mpfe/connexion.php
http://dj.joss.free.fr/trombine.htm
Avec plaisir
Philippe.R
"Patrick BASTARD" message de news:
Bonjour à toutes et tous.

Le code suivant fonctionne parfaitement.
Mais son exécution est très longue : 30 mn, montre en main, pour traiter
1886 lignes.
Auriez-vous une idée pour en accélérer l'exécution ?

D'avance, merci
***********************************************************
Sub Concaténère()

Application.ScreenUpdating = False
Dim a As Integer 'maxi : - 32768 à + 32767
Dim i As Integer
Dim j As Integer
Dim Nouveau

For a = 4 To Range("c32000").End(xlUp).Row
If Len(Cells(a, 3)) = 13 Then 'Trouve le premier guide
Nouveau = Cells(a, 3)
Exit For
End If
Next a
For i = 4 To Range("c32000").End(xlUp).Row
If Left(Cells(i, 3), 11) = Left(Nouveau, 11) Then
Cells(i, 3) = Nouveau 'Place le guide
Else
For j = i To Range("c32000").End(xlUp).Row
If Len(Cells(j, 3)) = 13 Then 'Trouve les autres guides
Nouveau = Cells(j, 3)
Cells(i, 3) = Nouveau
Exit For
End If
Next j
End If
Next i
End Sub
***********************************************************
--
Bien amicordialement,
P. Bastard

Avant d'imprimer ce mail, ayez une pensée pour les arbres.



MichDenis
Le #4978121
Il me semble que si tu utilisais des filtres élaborés successifs,
ce serait beaucoup plus rapide !

Il n'est pas évident de déduire la "meilleure" façon d'aborder un
problème à partir de la solution trouvée par quelqu'un d'autre...

Il est préférable que tu expliques ta problématique d'abord, quitte
à afficher par la suite ta réponse afin de ne pas recevoir une copie
de ce que tu as déjà effectué comme travail.



"Patrick BASTARD"
Bonjour à toutes et tous.

Le code suivant fonctionne parfaitement.
Mais son exécution est très longue : 30 mn, montre en main, pour traiter
1886 lignes.
Auriez-vous une idée pour en accélérer l'exécution ?

D'avance, merci
***********************************************************
Sub Concaténère()

Application.ScreenUpdating = False
Dim a As Integer 'maxi : - 32768 à + 32767
Dim i As Integer
Dim j As Integer
Dim Nouveau

For a = 4 To Range("c32000").End(xlUp).Row
If Len(Cells(a, 3)) = 13 Then 'Trouve le premier guide
Nouveau = Cells(a, 3)
Exit For
End If
Next a
For i = 4 To Range("c32000").End(xlUp).Row
If Left(Cells(i, 3), 11) = Left(Nouveau, 11) Then
Cells(i, 3) = Nouveau 'Place le guide
Else
For j = i To Range("c32000").End(xlUp).Row
If Len(Cells(j, 3)) = 13 Then 'Trouve les autres guides
Nouveau = Cells(j, 3)
Cells(i, 3) = Nouveau
Exit For
End If
Next j
End If
Next i
End Sub
***********************************************************
--
Bien amicordialement,
P. Bastard

Avant d'imprimer ce mail, ayez une pensée pour les arbres.
Patrick BASTARD
Le #4978101
Bonjour, *Philippe*

Bingo, dans le mille!!
La proc se réalise maintenant quasi instantanément.

Concernant Application.ScreenUpdating = True, il me semble que ce ne soit
pas nécessaire : voir la remarque de Michel Pierron :
http://groups.google.com/group/microsoft.public.fr.excel/browse_thread/thread/ce0d3b0700624644/e229bd1231b98b8a?hl=fr&lnk=st&q=&rnum=7#e229bd1231b98b8a
La mise à jour de l'écran se réalise en fin de procédure, même sans cette
commande.
Mais peut-être y a-t'il des cas où cette ligne est nécessaire ?

En tous cas, merci, Philippe. Tu me fais gagner 1/2h par semaine.

--
Bien amicordialement,
P. Bastard

Avant d'imprimer ce mail, ayez une pensée pour les arbres.


Bonjour Patrick,
La seule piste qui me vienne à l'esprit est de passer en calcul
manuel en début de proc et de repasser en automatique à la fin ;
surtout si tu as pas de formule dans le classeur.
A ce sujet, est ce délibérément que tu ne réactive pas le
rafraichissement d'écran en fin de proc ?
Bonjour à toutes et tous.

Le code suivant fonctionne parfaitement.
Mais son exécution est très longue : 30 mn, montre en main, pour
traiter 1886 lignes.
Auriez-vous une idée pour en accélérer l'exécution ?

D'avance, merci
***********************************************************
Sub Concaténère()

Application.ScreenUpdating = False
Dim a As Integer 'maxi : - 32768 à + 32767
Dim i As Integer
Dim j As Integer
Dim Nouveau

For a = 4 To Range("c32000").End(xlUp).Row
If Len(Cells(a, 3)) = 13 Then 'Trouve le premier guide
Nouveau = Cells(a, 3)
Exit For
End If
Next a
For i = 4 To Range("c32000").End(xlUp).Row
If Left(Cells(i, 3), 11) = Left(Nouveau, 11) Then
Cells(i, 3) = Nouveau 'Place le guide
Else
For j = i To Range("c32000").End(xlUp).Row
If Len(Cells(j, 3)) = 13 Then 'Trouve les autres guides
Nouveau = Cells(j, 3)
Cells(i, 3) = Nouveau
Exit For
End If
Next j
End If
Next i
End Sub
***********************************************************
--
Bien amicordialement,
P. Bastard

Avant d'imprimer ce mail, ayez une pensée pour les arbres.




Patrick BASTARD
Le #4978081
Bonjour, *Denis*

Merci pour ta réponse.
L'objectif de ce code est d'homogénéiser des références différentes (placées
en colonne 3) représentant les mêmes objets :
Exemples :
EE123456789FR est le même que EE123456789123
EE123456789FR est différent de EE123456788123
Cette proc, qui fait partie d'une "usine à gaz", fonctionne bien, mais le
temps d'exécution était rédhibitoire.
Le conseil de Philippe, de désactiver le calcul en début, pour le réactiver
à la fin, -évident après coup !!!- a parfaitement corrigé mon problème.


--
Bien amicordialement,
P. Bastard

Avant d'imprimer ce mail, ayez une pensée pour les arbres.


Il me semble que si tu utilisais des filtres élaborés successifs,
ce serait beaucoup plus rapide !

Il n'est pas évident de déduire la "meilleure" façon d'aborder un
problème à partir de la solution trouvée par quelqu'un d'autre...

Il est préférable que tu expliques ta problématique d'abord, quitte
à afficher par la suite ta réponse afin de ne pas recevoir une copie
de ce que tu as déjà effectué comme travail.



"Patrick BASTARD" le message de news:
Bonjour à toutes et tous.

Le code suivant fonctionne parfaitement.
Mais son exécution est très longue : 30 mn, montre en main, pour
traiter 1886 lignes.
Auriez-vous une idée pour en accélérer l'exécution ?

D'avance, merci
***********************************************************
Sub Concaténère()

Application.ScreenUpdating = False
Dim a As Integer 'maxi : - 32768 à + 32767
Dim i As Integer
Dim j As Integer
Dim Nouveau

For a = 4 To Range("c32000").End(xlUp).Row
If Len(Cells(a, 3)) = 13 Then 'Trouve le premier guide
Nouveau = Cells(a, 3)
Exit For
End If
Next a
For i = 4 To Range("c32000").End(xlUp).Row
If Left(Cells(i, 3), 11) = Left(Nouveau, 11) Then
Cells(i, 3) = Nouveau 'Place le guide
Else
For j = i To Range("c32000").End(xlUp).Row
If Len(Cells(j, 3)) = 13 Then 'Trouve les autres guides
Nouveau = Cells(j, 3)
Cells(i, 3) = Nouveau
Exit For
End If
Next j
End If
Next i
End Sub
***********************************************************


Publicité
Poster une réponse
Anonyme