Besoin d'aide d'un expert en optimisation de boucle
pier0
Messages postés67Date d'inscriptionmardi 19 juillet 2005StatutMembreDernière intervention 2 septembre 2005
-
25 juil. 2005 à 12:15
pier0
Messages postés67Date d'inscriptionmardi 19 juillet 2005StatutMembreDernière intervention 2 septembre 2005
-
26 juil. 2005 à 11:37
Bonjour,
Voici une bout de code qu'il faut que j'optimise en terme de rapidité:
en pratique: la variable lgne_max_OHS sera de l'odre de 1500 et lgne_max_Planning de l'odre de 600
Merci de me donner vos avis d'expert afin de m'aider à optimiser (rapidité) au mieux cette boucle...
*********************************Module***************************************
Sub Macro_Compare_Cmdes_OHS_Planning()
' Déclarations des variables locales
Dim lgne_max_Planning As Integer, lgne_max_OHS As Integer
Dim i As Integer, j As Integer, k As Integer
Dim semaphore As Boolean
Application.ScreenUpdating = False
' Recuperation nb de ligne de chaque feuille
Sheets("Planning").Select
lgne_max_Planning = Range("A1").CurrentRegion.Rows.Count
Sheets("Feuil3").Select
Sheets("Feuil3").Name = "OHS"
lgne_max_OHS = Range("A1").CurrentRegion.Rows.Count
' Recopie de la ligne d'en tête
k = 1
Rows(1).Select
Selection.Copy
Sheets("Feuil1").Select
Sheets("Feuil1").Name = "Résultats de comparaison"
Rows(k).Select
ActiveSheet.Paste
k = 2
Sheets("OHS").Select
' Parcours du report provenant de OHS et récupération des commandes
For j = 2 To lgne_max_OHS
If (Worksheets("OHS").Cells(j, 1).Value <> Empty) Then
semaphore = False
'Boucle de rech de comand (indexée par j dans feuille OHS) dans feuille Planning
For i = 1 To lgne_max_Planning
If (Worksheets("Planning").Cells(i, 1).Value <> Empty) Then
If ((Worksheets("Planning").Cells(i, 1).Value <> "LUNDI") And (Worksheets("Planning").Cells(i, 1).Value <> "MARDI") And (Worksheets("Planning").Cells(i, 1).Value <> "MERCREDI") And (Worksheets("Planning").Cells(i, 1).Value <> "JEUDI") And (Worksheets("Planning").Cells(i, 1).Value <> "VENDREDI") And (Worksheets("Planning").Cells(i, 1).Value <> "SAMEDI") And (Worksheets("Planning").Cells(i, 1).Value <> "DIMANCHE")) Then
If Worksheets("Planning").Cells(i, 1).Value = Worksheets("OHS").Cells(j, 1).Value Then
semaphore = True
End If
End If
End If
Next i
If semaphore = True Then
Sheets("OHS").Select
Rows(j).Select
Selection.Copy
Sheets("Résultats de comparaison").Select
Rows(k).Select
ActiveSheet.Paste
k = k + 1 'mise à jour
End If
ElseIf (Worksheets("OHS").Cells(j, 1).Value = Empty) Then
' A La colonne 1 ligne j valeur_cell3 est vide
End If
Next j
Application.ScreenUpdating = True 'Mise à jour de l'affichage
End Sub
********************************************************************************
Merci à toute ames charitables volant à mon secours
A voir également:
Besoin d'aide d'un expert en optimisation de boucle
Sheets("Feuil1").Name = "Résultats de comparaison"
'LA, JE SAIS PAS SI On PEUT FAIRE UN PASTE SPECIAL
Sheets("Feuil1").Rows(k).Select
Sheets("Feuil1").Paste
k = 2
' Sheets("OHS").Select
' Parcours du report provenant de OHS et récupération des commandes
For j = 2 To lgne_max_OHS
If (Worksheets("OHS").Cells(j, 1).Value Empty) Then
semaphore
=
False
'Boucle de rech de comand (indexée par j dans feuille OHS) dans feuille Planning
For
i = 1 To lgne_max_Planning
If
(Worksheets("Planning").Cells(i, 1).Value Empty) Then
If
((Worksheets("Planning").Cells(i, 1).Value "LUNDI") And
(Worksheets("Planning").Cells(i, 1).Value "MARDI") And
(Worksheets("Planning").Cells(i, 1).Value "MERCREDI") And
(Worksheets("Planning").Cells(i, 1).Value "JEUDI") And
(Worksheets("Planning").Cells(i, 1).Value "VENDREDI") And
(Worksheets("Planning").Cells(i, 1).Value "SAMEDI") And
(Worksheets("Planning").Cells(i, 1).Value "DIMANCHE")) Then
If
Worksheets("Planning").Cells(i, 1).Value = Worksheets("OHS").Cells(j,
1).Value Then
semaphore
= True
End
If
End
If
End
If
Next
i
If
semaphore = True Then
'
Sheets("OHS").Select
'
Rows(j).Select
'
Selection.Copy
Sheets("OHS").Rows(j).Copy
'
Sheets("Résultats de comparaison").Select
'
Rows(k).Select
'MEME REMARQUE QUE PLUS HAUT
Sheets("Résultats de comparaison").Rows(k).Select
ActiveSheet.Paste
k = k +
1 'mise
à jour
End
If
ElseIf (Worksheets("OHS").Cells(j, 1).Value = Empty) Then
'
A La colonne 1 ligne j valeur_cell3 est vide
End If
Next j
Application.ScreenUpdating = True 'Mise à jour de l'affichage
End Sub
Pour le filtrage, dans le menu données, Filtre->Filtre automatique.
Tu fais un essai de filtrage en enregistrant la macro
(Outils->Macro-> Nouvelle Macro). Adapte le code pour faire un
essai.
Pour le script SQL, tu peux utiliser XL comme une source de données
avec un connecteur OLEDB. Je l'ai fais avec un CSV. Mais ensuite, ça
devient hard.
pier0
Messages postés67Date d'inscriptionmardi 19 juillet 2005StatutMembreDernière intervention 2 septembre 2005 25 juil. 2005 à 16:53
Chris,
Que ve tu dire pas collage special.
D'autre part j'ai essayé avec Sheets("Résultats de comparaison").Rows(k).Select et ca me génère une erreur:
erreur d'execution 1004! la méthode select de la classe range a échoué.
je comprend pas pourkoi?
Vous n’avez pas trouvé la réponse que vous recherchez ?
pier0
Messages postés67Date d'inscriptionmardi 19 juillet 2005StatutMembreDernière intervention 2 septembre 2005 25 juil. 2005 à 19:31
Salut Jack
Si, bien sur que j'ai effectué les modif mais je cherche encore d'autre truc car mon prog tourne tj trop lentement.
D'autre part, je t'ai posé des nouvelles questions sur le post précédant(si tu pe y jeter un oeil ca serait cool)
a+
Pier0
cs_69chris
Messages postés318Date d'inscriptionjeudi 30 janvier 2003StatutMembreDernière intervention30 décembre 20051 26 juil. 2005 à 08:38
Si il n'y aucune cellule vide, les codes suivants sont identique :
Range("A1").CurrentRegion.Rows.Count
Range("A1").SpecialCells(xlLastCell).Row
Par contre, si une cellule est vide, la seconde ligne donne réellement la dernière ligne qui contient des infos.
Dans la doc de la méthode copy, il y a cet exemple ci:
Worksheets("Sheet1").Range("A1:D4").Copy _
destination:=Worksheets("Sheet2").Range("E5")
C'est ce que tu fais en plusieurs lignes avec des activation de feuilles. Ca doit être un peut plus rapide.
Ton code "
ElseIf (Worksheets("OHS").Cells(j, 1).Value = Empty)
Then" ne fait rein de particulier dans ton exemple. Faut il le garder?
Par contre, c'est claire que ca changera rien (en tout cas pas grand
chose) à tes perfs.
Sinon, tu connais les formules excel? Ce que tu fais existe peut-être déjà. Une fonction du genre "RechercheV".
Chris
pier0
Messages postés67Date d'inscriptionmardi 19 juillet 2005StatutMembreDernière intervention 2 septembre 2005 26 juil. 2005 à 11:37
Si il n'y aucune cellule vide, les codes suivants sont identique :
Range("A1").CurrentRegion.Rows.Count
Range("A1").SpecialCells(xlLastCell).Row 'MAIS C - RAPIDE!
Dans la doc de la méthode copy, il y a cet exemple ci:
Worksheets("Sheet1").Range("A1:D4").Copy _ destination:=Worksheets("Sheet2").Range("E5") 'JE VAIS TESTER...
Ton code "ElseIf (Worksheets("OHS").Cells(j, 1).Value = Empty) Then" ne fait rein de particulier dans ton exemple. Faut il le garder? Par contre, c'est claire que ca changera rien (en tout cas pas grand chose) à tes perfs.JE L'AI
VIRé
Sinon, tu connais les formules excel? Ce que tu fais existe peut-être déjà. Une fonction du genre "RechercheV". 'MOI G PAS ESSAYé MAIS g 1 COLLèGUE QUI A ESSAYé ET CA A L'AIR + LENT QUE MON PROG...