Programme inefficace

Résolu/Fermé

berloutte - Modifié par pijaku le 27/08/2014 à 12:02
berloutte - 28 août 2014 à 14:22

Bonjour tout le monde,

Je viens pour demander de l'aide !
J'essaie de faire un macro faisant correspondre 2 tableaux.
Le premier serait un recap de l'autre. C'est à dire que je rentre mes données dans le deuxième et le premier se modifierait tout seul.

Premier tableau récap : "Point sur Logement"
Deuxième tableau dans lequel je rentre mes données : "Liste des réserves"

Mon programme ressemble à ça :

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, 5).Value = "Autocontrole" And Worksheets("Liste réserves").Cells(j, 3).Value = "100PLOMBS" And Worksheets("Liste réserves").Cells(j, 7).Value <> "" Then
        Worksheets("Point sur Logements").Cells(i, 10) = "Réserves"
        Exit For
        End If
    Next j
Next i

End Sub

La première boucle avec les i permet de mettre à jour case par case une colonne du premier tableau (la colonne 10) par rapport a un numéro présent dans la colonne 4.
La boucle j recherche dans le deuxième tableau les lignes répondant à certains critères. Si les critères sont vérifiés alors le mot "Réserves" est inscrit sur la ligne correspondante de la colonne 10 sur le premier tableau.

Alors quand ma macro se lance, déjà elle met beaucoup de temps et ensuite rien ne se passe.

J'ai donc quelques questions : Savez vous me dire pourquoi rien ne se passe ? Auriez vous une idée pour contourner cette méthode car la macro met 20sec pour mettre a jour une seule colonne (la colonne 10) alors que j'en ai 8 ?

Je ne sais pas si j'ai été clair mais en tout cas je remercie déjà ceux qui m'ont lu jusqu'au bout.

Humbert

A voir également:

Programme inefficace
Programme demarrage windows 10 - Guide
Programme démarrage windows 10 - Guide
Fichier ouvert dans un autre programme - Guide
Desinstaller un programme - Guide
Programme bonjour c'est quoi ✓ - Forum Logiciels

3 réponses

Réponse 1 / 3

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
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:

Worksheets("Liste réserves").Cells(j, 1).Value = log

log n'est qu'une seul fois dans la colonne A de "Liste réserves" ????

berloutte
27 août 2014 à 13:04

1. L'ordinateur charge pendant une vingtaine de secondes et je ne peux rien faire.

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 !!

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
27 août 2014 à 13:46

Re,

d'ici une heure ou deux, je peux vous mettre un fichier avec recherche un peu optmisee

A+

Réponse 2 / 3

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

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

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
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

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

Oui f894009

ça peu aller
Le ciel est bien nuageux, mais ils sont beaux

berloutte
27 août 2014 à 14:02

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 !

Réponse 3 / 3

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

Rebonjour berloutte

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

berloutte
27 août 2014 à 14:17

Super !! Merci beaucoup, c'est en effet beaucoup plus rapide ! C'est parfait ! Je vais maintenant tenter de généraliser ça sur toutes mes colonnes ! Encore merci Iama !

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
Modifié par f894009 le 27/08/2014 à 14:54

Re,

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

C'est certain beaucoup plus rapide

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

bonjour f894009

Il ne manquerait-il pas un point dans derligLR = Range("A" & Rows.Count).End(xlUp).Row ?

cordialement

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
Modifié par f894009 le 27/08/2014 à 15:26

Re,

Si, je l'ai rajoute apres avoir publie la premiere fois

Discussions similaires

programme qui n'affiche pas le mot secret

Pourquoi Program files (x86) et Programmes?

"BONJOUR" : utilité de ce programme???

TV LG affiche le carré non programmé

GWXUX a cessé de fonctionner

Discussions similaires

Newsletters