Programme inefficace

Résolu
berloutte -  
 berloutte -
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

3 réponses

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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" ????
    1
    1. berloutte
       
      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 !!
      0
    2. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,

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

      A+
      0
  2. Iama Messages postés 324 Statut Membre 14
     
    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
    1
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Bonjour,

      ca roule??

      C'est ce qui expliquerait que rien ne se passe et 500 et quelques mille iterations pour rien
      0
    2. Iama Messages postés 324 Statut Membre 14
       
      Oui f894009

      ça peu aller
      Le ciel est bien nuageux, mais ils sont beaux
      0
    3. berloutte
       
      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 !
      0
  3. Iama Messages postés 324 Statut Membre 14
     
    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
    1
    1. berloutte
       
      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 !
      0
    2. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      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
      0
    3. Iama Messages postés 324 Statut Membre 14
       
      C'est certain beaucoup plus rapide

      Alain
      0
    4. Iama Messages postés 324 Statut Membre 14
       
      bonjour f894009

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

      cordialement
      0
    5. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,

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

Discussions similaires

TV LG "Non programmé"
Chantal Joubert -
Mancini -

5 réponses
"BONJOUR" : utilité de ce programme???
sunbeep -
onizukaille -

5 réponses
logiciel bonjour
cougar0259 -
lorent -

17 réponses
A quoi sert l'application Bonjour?
patrick -
Ysis -

4 réponses