Macro à optimiser

Joe_cooker

XLDnaute Nouveau
Bonjour à tous et a toutes
voici une autre je demande votre aide. d'avance merci a vous car grace a vous j'ai appris bcp.
j'essaye de me débrouiller tt seul en consultant ce forum mais il me reste des améliorations à apporter.
bref, je fais une copie coller d'un document text sous bloc note vers une feuille excel.
pour extraire les données que j'ai besoin j'utilise des formule avec vba et par la suite de procede à une extraction ds une autre feuille à l'aide du code application-match. voici les étapes:
coller ds colonne a feuille1
ds colonne B , C et D: j'utilise les Formules suivantes à l'aide du code ci dessous:

Sub Formul_SAL()

'Formul1 Macro
'
With Worksheets("SAL").Range("B2:B" & Worksheets("SAL").Range("A65000").End(xlUp).Row)
.Formula = "=TRIM(RC[-1])"
End With
'
' Formul4 Macro
'
With Worksheets("SAL").Range("C2:C" & Worksheets("SAL").Range("A65000").End(xlUp).Row)
.Formula = _
"=TRIM(SUBSTITUTE(REPLACE(RC[-2],25,200,""""),""."",""""))"
End With

' Formul5 Macro
'
With Worksheets("SAL").Range("D2:D" & Worksheets("SAL").Range("A65000").End(xlUp).Row)
.Formula = _
"=TRIM(SUBSTITUTE(REPLACE(RC[-3],1,25,""""),""*"",""""))"
End With
End Sub

jusqu'à la il n y a pas de probleme.

pour exploiter les données j'ai besoin de répartir les données de la colonne D ds les colonnes qui suit E , F ,G .... ces colonne varient selon le nombre d'accurences que j'ai obtenu ds la colonne D (ces données peuvent etre chiffre ou des lettre et sont séparés par un espace)
Pour réaliser cela. j'ai trouvé un code qui me convient parfaitement mais l'inconvinient est qui est tres long ,ca prend bcp de temps et je peux pas lancer à partir d'une autre feuille sans passer par la feuille1 ( ou se trouve les données à traiter par la suite. voici le code que j' utilse :
ce code me convient et mon probleme est sa lenteur et qe je ne p pas l'utiliser sans passer par la feuille ou se trouve les données:

Sub Repart_SCE()
'
' nom_prénom Macro
' Macro enregistrée le 01/09/2003 par Parents
'
Dim i, j, k, l As Integer
Dim n, nm As String

Sheets("SCE").Activate
l = Range("D65000").End(xlUp).Row

For i = 1 To l
k = 5
nm = Cells(i, 4): n = ""
For j = 1 To Len(Cells(i, 4))
If Mid(nm, j, 1) = " " Then Cells(i, k) = n: k = k + 1: n = "": GoTo label1
n = n + Mid(nm, j, 1)
label1:
Next j
Cells(i, k) = n
Next i
Sheets("RRE (2)").Activate
'
End Sub

si quelqu'un peut m'aider pour optimiser mes codes je serait reconnaissant.
NB: mon fichier est tres lourd et j'arrive pas à avoir 50k
il y a plus que 15 000 lignes a traiter et `plusieurs feuille de calcules
désolé de ne pas pouvoir envoyer le fichier . j'essayé avec winrar tout en laissant juste le minmum donnes ds le fichier mais il est lourd
j'espere etre explicite

Merci d'avance
 

ClementMaillioux

XLDnaute Nouveau
Re : Macro à optimiser

Bonjour à tous,

Joe_Cooker, pour votre problème de rapidité :
La question de la rapidité dépend avant tout de la puissance de l'ordinateur, vous et moi n'aurons pas le même temps d'exécution de cette macro sur nos machines respectives.
Le code que vous avez fourni me semble déjà très bien optimisé pour un calcul rapide de la tâche que vous demandez; après quelques essais pour m'y prendre différemment, j'ai réussi à passé de 2:03 minutes à 1:53 minute d'exécution simplement en désactivant le rafraichissement dans le Sub "Extra" comme suit :
Code:
Sub extra()
Application.ScreenUpdating = False
Call Formul_SCE
Call Repart_SCE
Call SCE
Application.ScreenUpdating = True
End Sub

Pour votre problème d'accessibilité à la macro :
Je ne suis pas certain d'avoir compris le problème mais il semble que vous désireriez pouvoir activer la macro à partir d'autres endroits que la page où se trouve le bouton.
Partant du principe que vous utilisez Excel 97 - 2003 je vous invite à réaliser pour cela une barre d'outils personnalisée :
1) Sélectionnez Outils > Personnaliser... dans la barre de menus
2) Cliquez sur Nouvelle... et nommez votre barre d'outils : vous verrez qu'elle apparaît quelque part, "flottant" sur le classeur
3) Allez ensuite dans l'onglet Commandes et choisissez "Macros" dans le menu de gauche.
4) Faites glisser le "Bouton personnalisé" du menu de droite vers la barre d'outils que vous avez créée.
5) Cliquez droit sur l'icône que vous venez de placer dans la barre d'outil et choisissez "Affecter une macro"
6) Choisissez la Macro "Extra"
7) Fermez la boite de dialogue.

Je vous conseille de déplacer la nouvelle barre d'outil avec les autres (celles d'origine) grâce à un cliquer-déplacer pour libérer la vue du classeur.

Bon dimanche!
 

Joe_cooker

XLDnaute Nouveau
Re : Macro à optimiser

Bonjour à tous,

Joe_Cooker, pour votre problème de rapidité :
Merci Clément Maillioux,
moi aussi ca me prend à peu près 2 minutes pour excuter ca macro. mon probleme est que j'utilise le meme code pour realiser 3 ou 4 macros qui font la meme tache mais ds trois au quatre feuille differente c'est à dire:
Sub extra()
....
Call Formul_SCE
....
....
Call Repart_SCE
Call Repart_SAL
Call Repart_BQ90

.....
.....
Call SCE
Application.ScreenUpdating = True
End Sub

donc j'ai 3 fois 2 minutes=6minutes.
j'ai pensé que peut etre avec fonction volatile de type SPLIT peut faire l'affaire mais je sais pas comment proceder. est ce que vous pensez que si realisable avec SPLIT volatile

Pour la question de lancer la macro peut etre j'ai mal expliqué mon besoin.
j'ai besoin juste que lorsque je lance la macro avec le bouton EXTRA de la feuille RRE (2) que je reste ds la meme feuille RRE (2). car avec l'excution de mes macro l'utilisateur va voir parcourir 3 ou 4 feuilles lors de l'excution.
j'ai ajouté With ds mes macros Repart pour que je puisse rester ds la feuille RRE (2). lors de l'excution de mes macros mais ca marche pas.

Clément Maillioux si vous avez des idees je vous remercie
et merci à tous et a toutes qui pourons m'aider.
Salut.
 

ClementMaillioux

XLDnaute Nouveau
Re : Macro à optimiser

Pour la question de lancer la macro peut etre j'ai mal expliqué mon besoin.
j'ai besoin juste que lorsque je lance la macro avec le bouton EXTRA de la feuille RRE (2) que je reste ds la meme feuille RRE (2). car avec l'excution de mes macro l'utilisateur va voir parcourir 3 ou 4 feuilles lors de l'excution.

Bonjour!

Si vous supprimez le rafraichissement de l'écran comme je vous l'indiquais, le code s'exécutera sans problème et les utilisateurs ne verront pas la macro se balader dans les pages du classeur, la vue restera figée sur la page RRE(2).

Cordialement.
 

Paritec

XLDnaute Barbatruc
Re : Macro à optimiser

Bonjour Joe_cooker, Clément, le forum
Perso chez moi en désactivant le rafraichissement de l'affichage, la macro se déroule en 10,48 secondes
Maintenant pour aller plus vite il peut passer par des tableaux là c'est garantie de gagner beaucoup.
a+
Papou :)

Code:
Sub extra()
t = Timer
Application.ScreenUpdating = False
Call Formul_SCE
Call Repart_SCE
Call SCE
Application.ScreenUpdating = True
Feuil10.Range("L2") = Timer - t
End Sub
 
Dernière édition:

Joe_cooker

XLDnaute Nouveau
Re : Macro à optimiser

Bonjour Clément,Paritec, le forum
Merci bcp pour vous les deux.
j'aimerai vous informer que j'ai reussi à resoudre mes deux problemes.
En effet, pour lancer les macros à partir de la feuille R (2) sans passer par la feuille (Sheets("SCE") ) ou s'excutent les macros, j'ai definit cette derniere par (Set) et j'ai j'ai reussi à la fois de rester ds la meme feuille R (2) et de reduire considerablement le temps d'excution qlq secondes (10-15 sec). voir ci dessous les modificatios que j'ai apporté à ce code (en rouge).
je vais ajouter Application.ScreenUpdating = False/true à ce code.
en passant, je savait pas le role la désactivation du rafraichissement de l'affichage. avec un petite recherche et des essai, j'ai compris qu'elle permet de reduire le temps d'excution mais elle permet pas de rester ds la meme feuille lors de l'excution.
Clément, corrige moi si pas vrai mais j'ai fait des essais.
finalement un gros merci à vous les deux et tres content de vous lire et d'apprendre de vous. voir le code ci-bas. si vous avez des commentaires n'hésitez pas.

Sub Repart_SCE1()
'
Dim i, j, k, l As Integer
Dim n, nm As String
Set COSA = Sheets("SCE")
l = COSA.Range("D65000").End(xlUp).Row

For i = 1 To l
k = 5
nm = COSA.Cells(i, 4): n = ""
For j = 1 To Len(COSA.Cells(i, 4))
If Mid(nm, j, 1) = " " Then COSA.Cells(i, k) = n: k = k + 1: n = "": GoTo label1
n = n + Mid(nm, j, 1)
label1:
Next j
COSA.Cells(i, k) = n
Next i

'
End Sub
 

ROGER2327

XLDnaute Barbatruc
Re : Macro à optimiser

Bonsoir à tous
Code:
[COLOR="DarkSlateGray"][B]Sub Repart_SCE()
[COLOR="SeaGreen"]'
'            ROGER2327 fecit.
'[/COLOR]
Dim i&, j&, l&
Dim n, oDat
   With Sheets("SCE")
      l = .Cells(.Rows.Count, 4).End(xlUp).Row
      oDat = .Range(.Cells(1, 4), .Cells(l, 4)).Value
      For i = 1 To l
         n = Split(oDat(i, 1))
         If UBound(n) >= UBound(oDat, 2) Then ReDim Preserve oDat(1 To l, 1 To 1 + UBound(n))
         For j = 0 To UBound(n)
            oDat(i, 1 + j) = n(j)
         Next j
      Next i
      .Range("E1").Resize(l, UBound(oDat, 2)).Value = oDat
   End With
End Sub[/B][/COLOR]
devrait être beaucoup plus rapide.
À vous de voir si ce code fait bien le travail attendu...​
ROGER2327
#3124
 

ClementMaillioux

XLDnaute Nouveau
Re : Macro à optimiser

Bonjour à tous,

Simplement un message pour remercier tous les contributeurs car je me suis aussi intéressé à ce sujet (et ce forum entier d'ailleurs!) pour constater la variété de solutions qu'on peut appliquer à un même problème : Je suis servi!
 

ROGER2327

XLDnaute Barbatruc
Re : Macro à optimiser

Bonjour à tous
Suite à un message de Joe_cooker me demandant de commenter le code, je m'exécute.
Code:
[COLOR="DarkSlateGray"][B]Sub Repart_SCE()
'
'            ROGER2327 fecit.
'
Dim i&, j&, l& [COLOR="SeaGreen"]'1[/COLOR]
Dim n, oDat [COLOR="SeaGreen"]'2[/COLOR]
   With Sheets("SCE") [COLOR="SeaGreen"]'3[/COLOR]
      l = .Cells(.Rows.Count, 4).End(xlUp).Row [COLOR="SeaGreen"]'4[/COLOR]
      oDat = .Range(.Cells(1, 4), .Cells(l, 4)).Value [COLOR="SeaGreen"]'5[/COLOR]
      For i = 1 To l [COLOR="SeaGreen"]'6[/COLOR]
         n = Split(oDat(i, 1)) [COLOR="SeaGreen"]'7[/COLOR]
         If UBound(n) >= UBound(oDat, 2) Then ReDim Preserve oDat(1 To l, 1 To 1 + UBound(n)) [COLOR="SeaGreen"]'8[/COLOR]
         For j = 0 To UBound(n) [COLOR="SeaGreen"]'9[/COLOR]
            oDat(i, 1 + j) = n(j)
         Next j [COLOR="SeaGreen"]'9[/COLOR]
      Next i [COLOR="SeaGreen"]'6[/COLOR]
      .Range("E1").Resize(l, UBound(oDat, 2)).Value = oDat [COLOR="SeaGreen"]'10[/COLOR]
   End With [COLOR="SeaGreen"]'3[/COLOR]
End Sub

[COLOR="SeaGreen"]'1:
'   Déclaration des variables :
'i et l doivent être déclarées comme "Long" si le nombre de lignes à _
traiter dépasse 2^15.
'j est déclaré comme "Long", qui est le type le plus approprié aux _
indices de boucle.
'
'2:
'   Déclaration des variables :
'n et oDat ne sont pas typées : elles sont implicitement typées _
comme "Variant"
'
'3:
'   La structure With... ...End With permet de simplifier le code en _
évitant la répétition de la référence à Sheets("SCE").
'   Toutes les instructions précédées de '.' dans cette structure _
doivent se comprendre comme précédées de 'Sheets("SCE").'.
'
'4:
'   Affectation du numéro de la dernière cellule non vide de la _
colonne 4 (D) à la variable l.
'   Dans une feuille d'Excel2003, Rows.Count renvoie 2^16 (=65536).
'   Dans une feuille d'Excel2007, Rows.Count renvoie 2^20 (=1048576).
'
'5:
'   La variable oDat est définie comme un tableau de l lignes et une _
colonne contenant les valeurs de la plage Sheets("SCE").Range("D1:Dl").
'
'6:
'   Boucle dans laquelle on va traiter le contenu des l lignes du _
tableau oDat.
'
'7:
'n est défini comme un tableau de chaînes de caractères dont les _
éléments sont les sous-chaînes de longueur maximale de oDat(i, 1) _
ne contenant aucune espace.
'Si oDat(i, 1) est vide, n est un tableau ne contenant aucune variable.
'Si oDat(i, 1) n'est pas vide, le nombre d'éléments de n est égal au _
nombre d'espaces contenues dans oDat(i, 1), plus un.
'En particulier, si oDat(i, 1) ne contient pas d'espace, n contient _
un seul élément dont la valeur est celle de oDat(i, 1).
'À savoir : l'indice du premier élément du tableau n est zéro (et non un). _
On dit que n est un tableau de base zéro.
'
'8:
'   On compare le nombre de colonnes des tableaux n et oDat, et si _
le nombre de colonnes du tableau n est supérieur au nombre de colonnes _
du tableau oDat on étend le tableau oDat pour qu'il possède autant de _
colonnes que le tableau n.
'
'9:
'   Boucle dans laquelle on copie les éléments de n dans la ligne i _
du tableau oDat.
'
'10 :
'   On dépose le contenu du tableau oDat dans la feuille Sheets("SCE"), _
à partir de la cellule "E1".[/COLOR][/B][/COLOR]
ROGER2327
#3129
 
Dernière édition:

Discussions similaires

Réponses
7
Affichages
355

Statistiques des forums

Discussions
312 413
Messages
2 088 201
Membres
103 762
dernier inscrit
rouazali