Programme inefficace
Résolu/Fermé
A voir également:
- Programme inefficace
- Programme demarrage windows 10 - Guide
- Mettre en veille un programme - Guide
- Cette action ne peut pas être réalisée car le fichier est ouvert dans un autre programme - Guide
- Désinstaller programme windows 10 - Guide
- Sms programmé - Guide
3 réponses
f894009
Messages postés
17241
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
19 février 2025
1 713
27 août 2014 à 10:42
27 août 2014 à 10:42
Bonjour,
deux questions:
1: comment savez-vous, si rien ne ce passe, que la macro met 20s a executer votre code ???
2:
deux questions:
1: comment savez-vous, si rien ne ce passe, que la macro met 20s a executer votre code ???
2:
Worksheets("Liste réserves").Cells(j, 1).Value = loglog n'est qu'une seul fois dans la colonne A de "Liste réserves" ????
Iama
Messages postés
319
Date d'inscription
mercredi 13 janvier 2010
Statut
Membre
Dernière intervention
27 mars 2020
14
27 août 2014 à 11:37
27 août 2014 à 11:37
Bonjour berloutte
As tu fais tourner ta macro au pas à pas (F8)?
Tes conditions sont-elles réunis sur ton ficher et combien de fois?
Apparemment ton Exit For intrigue aussi f894009, que je salut
cordialement
As tu fais tourner ta macro au pas à pas (F8)?
Tes conditions sont-elles réunis sur ton ficher et combien de fois?
Apparemment ton Exit For intrigue aussi f894009, que je salut
cordialement
f894009
Messages postés
17241
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
19 février 2025
1 713
27 août 2014 à 11:53
27 août 2014 à 11:53
Bonjour,
ca roule??
C'est ce qui expliquerait que rien ne se passe et 500 et quelques mille iterations pour rien
ca roule??
C'est ce qui expliquerait que rien ne se passe et 500 et quelques mille iterations pour rien
Iama
Messages postés
319
Date d'inscription
mercredi 13 janvier 2010
Statut
Membre
Dernière intervention
27 mars 2020
14
27 août 2014 à 13:49
27 août 2014 à 13:49
Oui f894009
ça peu aller
Le ciel est bien nuageux, mais ils sont beaux
ça peu aller
Le ciel est bien nuageux, mais ils sont beaux
Bonjour,
Quand je l'exécute pas à pas, il me surligne en jaune la ligne :
If Worksheets("Liste réserves").Cells(j, 1).Value = log And Worksheets("Liste réserves").Cells(j, 5).Value = "Autocontrole" And Worksheets("Liste réserves").Cells(j, 3).Value = "100PLOMBS" And Worksheets("Liste réserves").Cells(j, 7).Value <> "" Then
puis quand je rappuis il surligne End If puis Next J...
Mes conditions me semblent réunis oui, j'ai remodifié certaines choses par rapport aux colonnes mais ca revient au meme :
Private Sub Worksheet_Activate()
Dim i As Integer
Dim j As Integer
Dim log
For i = 2 To 520
log = Worksheets("Point sur logements").Cells(i, 4).Value
For j = 3 To 1000
If Worksheets("Liste réserves").Cells(j, 1).Value = log And Worksheets("Liste réserves").Cells(j, 7).Value = "Autocontrole" And Worksheets("Liste réserves").Cells(j, 5).Value = "100PLOMBS" And Worksheets("Liste réserves").Cells(j, 9).Value = "" Then
Worksheets("Point sur Logements").Cells(i, 10).Value = "Réserves"
Exit For
End If
Next j
Next i
End Sub
Merci beaucoup pour ta réponse Iama !
Quand je l'exécute pas à pas, il me surligne en jaune la ligne :
If Worksheets("Liste réserves").Cells(j, 1).Value = log And Worksheets("Liste réserves").Cells(j, 5).Value = "Autocontrole" And Worksheets("Liste réserves").Cells(j, 3).Value = "100PLOMBS" And Worksheets("Liste réserves").Cells(j, 7).Value <> "" Then
puis quand je rappuis il surligne End If puis Next J...
Mes conditions me semblent réunis oui, j'ai remodifié certaines choses par rapport aux colonnes mais ca revient au meme :
Private Sub Worksheet_Activate()
Dim i As Integer
Dim j As Integer
Dim log
For i = 2 To 520
log = Worksheets("Point sur logements").Cells(i, 4).Value
For j = 3 To 1000
If Worksheets("Liste réserves").Cells(j, 1).Value = log And Worksheets("Liste réserves").Cells(j, 7).Value = "Autocontrole" And Worksheets("Liste réserves").Cells(j, 5).Value = "100PLOMBS" And Worksheets("Liste réserves").Cells(j, 9).Value = "" Then
Worksheets("Point sur Logements").Cells(i, 10).Value = "Réserves"
Exit For
End If
Next j
Next i
End Sub
Merci beaucoup pour ta réponse Iama !
Iama
Messages postés
319
Date d'inscription
mercredi 13 janvier 2010
Statut
Membre
Dernière intervention
27 mars 2020
14
Modifié par Iama le 27/08/2014 à 13:44
Modifié par Iama le 27/08/2014 à 13:44
Rebonjour berloutte
J'ai un peu augmenté la rapidité de ton code.
et je te propose une organisation plus lisible de celui-ci
cordialement
J'ai un peu augmenté la rapidité de ton code.
et je te propose une organisation plus lisible de celui-ci
Private Sub Worksheet_Activate() Dim i As Integer Dim j As Integer Dim lOg Dim ligpL As Integer, ligR As Integer Dim c3, c5, c7, c1 ' utilisé uniquement pour les tests 'Initialisation Const inscrIt = "Réserves" Const autO_5 = "Autocontrole" Const plomb_3 = "100PLOMBS" 'les derniére lignes utilisées ligpL = Worksheets("Point sur logements").Cells(Rows.Count, 4).End(xlUp).Row ligR = Worksheets("Liste réserves").Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To ligpL lOg = Worksheets("Point sur logements").Cells(i, 4).Value With Worksheets("Liste réserves") For j = 3 To ligR c1 = .Cells(j, 1).Value c3 = .Cells(j, 3).Value c5 = .Cells(j, 5).Value c7 = .Cells(j, 7).Value If (.Cells(j, 1).Value = lOg) = True _ And (.Cells(j, 5).Value = autO_5) = True _ And (.Cells(j, 3).Value = plomb_3) = True _ And .Cells(j, 7).Value = Empty = False _ Then Worksheets("Point sur Logements").Cells(i, 10) = inscrIt Exit For End If Next j End With Next i End Sub
cordialement
f894009
Messages postés
17241
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
19 février 2025
1 713
Modifié par f894009 le 27/08/2014 à 14:54
Modifié par f894009 le 27/08/2014 à 14:54
Re,
permet de ne pas balayer toutes les lignes systematiquement avant de trouver la bonne:
permet de ne pas balayer toutes les lignes systematiquement avant de trouver la bonne:
Private Sub Worksheet_Activate()
Dim derligPL As Integer, derligLR As Integer
Dim Nb As Integer, Lig As Integer, iter As Integer
Application.ScreenUpdating = False
'les derniére lignes utilisées
With Worksheets("Point sur logements")
derligPL = .Range("D" & Rows.Count).End(xlUp).Row
Set plage = .Range("D2:D" & derligPL)
End With
With Sheets("Liste réserves")
derligLR = Range("A" & Rows.Count).End(xlUp).Row
Set col_A = .Range("A3:A" & derligLR)
End With
For Each cel In plage
With Sheets("Liste réserves")
'Recherche du nombre d'occurence
Nb = Application.CountIf(col_A, cel)
If Nb > 0 Then
Lig = 2
For iter = 1 To Nb
Lig = .Columns("A").Find(cel, .Cells(Lig, "A"), , xlWhole).Row
If .Cells(Lig, 1).Value = cel And _
.Cells(Lig, 7).Value = "Autocontrole" And _
.Cells(Lig, 5).Value = "100PLOMBS" And _
.Cells(Lig, 9).Value = "" Then
Worksheets("Point sur Logements").Cells(cel.Row, 10) = "Réserves"
Exit For
End If
Next iter
End If
End With
Next cel
Application.ScreenUpdating = True
End Sub
Iama
Messages postés
319
Date d'inscription
mercredi 13 janvier 2010
Statut
Membre
Dernière intervention
27 mars 2020
14
27 août 2014 à 15:06
27 août 2014 à 15:06
C'est certain beaucoup plus rapide
Alain
Alain
Iama
Messages postés
319
Date d'inscription
mercredi 13 janvier 2010
Statut
Membre
Dernière intervention
27 mars 2020
14
27 août 2014 à 15:21
27 août 2014 à 15:21
bonjour f894009
Il ne manquerait-il pas un point dans derligLR = Range("A" & Rows.Count).End(xlUp).Row ?
cordialement
Il ne manquerait-il pas un point dans derligLR = Range("A" & Rows.Count).End(xlUp).Row ?
cordialement
f894009
Messages postés
17241
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
19 février 2025
1 713
Modifié par f894009 le 27/08/2014 à 15:26
Modifié par f894009 le 27/08/2014 à 15:26
Re,
Si, je l'ai rajoute apres avoir publie la premiere fois
Si, je l'ai rajoute apres avoir publie la premiere fois
27 août 2014 à 13:04
2. Non il est susceptible de l'être à plusieurs reprises, mais il me suffit d'une seule fois pour écrire "Réserves". C'est à dire que si au moins une ligne répond à tous ces critères, alors j'aimerai que "Réserves" apparaisse dans le premier tableau.
Merci beaucoup de votre réponse, merci !!
27 août 2014 à 13:46
d'ici une heure ou deux, je peux vous mettre un fichier avec recherche un peu optmisee
A+