Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Optimisation code VBA

Optimisation code VBA

4 réponses
Avatar
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.
Signaler un problème avec ce contenu

4 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Philippe.R
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" a écrit dans 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
***********************************************************
--
Bien amicordialement,
P. Bastard

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



Avatar
MichDenis
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" a écrit dans 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
***********************************************************
--
Bien amicordialement,
P. Bastard

Avant d'imprimer ce mail, ayez une pensée pour les arbres.
Avatar
Patrick BASTARD
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.




Avatar
Patrick BASTARD
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" a écrit dans
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
***********************************************************