Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
1491 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  macro trop lente - double boucle do while

 
 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

macro trop lente - double boucle do while

n°2208972
lnmex
Posté le 01-11-2013 à 23:14:16  profilanswer
 

Bonjour
 
Je viens de réaliser une macro qui a partir d'une liste de troncons (de rivieres) et de noeuds correspondants aux troncons
par ex: troncon 2 est connecté au noeud 2 et 882
récupère l'aire drainée du noeud qui suit
 
Par exemple:
feuille3 : j'ai une liste de noeud qui contiennent les noeuds de la riviere principale
             je prend un noeud, et je vais voir ceux qui suivent dans la feuille 2
             si le noeud n'est pas dans la liste de la feuille 3 alors je garde l'aire du noeud correspondant en le cherchant dans la feuille 1
 
Les listes des 3 feuilles sont différentes la feuille 2 suit une liste a partir d'un troncon noeud1 et noeud2 qui correspondent à ce troncon.
La feuille1 a tous les noeuds et l'aire correspondante
La feuille 3 a une liste de noeuds de la riviere principale
 
Je fais tout ca pour récupérer les noeuds avec les 4 aires les plus grandes
 
J'espère que tout est clair...
 
Donc j'ai principalement 2 grosses boucles : une qui tourne dans la feuille3 et une qui tourne dans la feuille 2 pour récupérer les noeuds
 
Tout fonctionne comme je veux mais ma macro est un escargot... je ne sais pas trop quoi faire pour l'améliorer...
 
Vous pourriez m'aider? Merci!
 

Code :
  1. Dim nodo As Boolean
  2. Dim tabnodo(500) As Integer
  3. Dim tabarea(500) As Double
  5. nod = 0
  6. t = 2
  8. Do While Not Cells(t, "A" ) = 0
  10.     'nodo de la Red principal
  11.     Sheets("Redprincipal" ).Select
  12.     nodoRedPrinc = Cells(t, "B" )
  14.     'se recuperan los nodos
  15.    
  16.     Sheets("Tramos" ).Select
  17.     i = 4
  18.     Do While Not Cells(i, "A" ) = ""
  19.        
  20.         Sheets("Tramos" ).Select
  21.         nodo1 = Cells(i, "C" )
  22.        
  23.         'si el nodo1 es igual al nodo de la Red Principal
  24.         If nodo1 = nodoRedPrinc Then
  25.        
  26.             'se verifica si el nodo2 ligado al nodo1 pertenece a la lista de los nodos de la Red Principal
  27.             nodo2 = Cells(i, "D" )
  28.            
  29.             Sheets("Redprincipal" ).Select
  30.             n = 2
  31.             nodo = False
  32.             Do While Not Cells(n, "A" ) = ""
  33.                 If Cells(n, "B" ) = nodo2 Then
  34.                     nodo = True
  35.                     Exit Do
  36.                 End If
  37.                 n = n + 1
  38.             Loop
  39.            
  40.             'si no pertenece se agrega el nodo y el area dentro de la lista
  41.             If nodo = False Then
  42.                 tabnodo(nod) = nodo2
  43.                 MsgBox (tabnodo(nod))
  44.                
  45.                            
  46.                 'se busca el area del nodo
  47.                 Sheets("Nodos" ).Select
  48.                 a = 2
  49.                 Do While Not Cells(a, "A" ) = ""
  50.                     If Cells(a, "A" ) = nodo2 Then
  51.                         tabarea(nod) = Cells(a, "D" )
  52.                         Exit Do
  53.                     End If
  54.                     a = a + 1
  55.                 Loop
  56.                 nod = nod + 1
  57.              End If
  58.    
  59.         End If
  60.         Sheets("Tramos" ).Select
  61.         i = i + 1
  62.     Loop
  64.     t = t + 1
  65. Loop


Message édité par lnmex le 01-11-2013 à 23:15:40
mood
Publicité
Posté le 01-11-2013 à 23:14:16  profilanswer
 

n°2208975
Takama13
Posté le 02-11-2013 à 02:45:14  profilanswer
 

Salut,
Tu devrais commencer par ne pas utiliser les .select.
Cela te fait perdre du temps pour rien.

n°2208977
lnmex
Posté le 02-11-2013 à 04:12:40  profilanswer
 

Merci, je vais essayer de tout mettre sur la même feuille tu as raison!

n°2208978
lnmex
Posté le 02-11-2013 à 05:45:20  profilanswer
 

Ca y est et oui ca marche! c'est 100 fois plus rapide merci!!!

n°2208979
lnmex
Posté le 02-11-2013 à 05:46:37  profilanswer
 

Une autre question, en passant, je voudrais mettre une taille à mes tableaux qui depend du nombre de données que j 'ai dans une colonne comment je fais?
je sais qu'il faut que je fasse Dim tab() as integer par ex
Preserve Redim je crois mais ensuite comment je fais pour avoir exactement le nombre de valeurs? merci

n°2208987
Takama13
Posté le 02-11-2013 à 10:27:06  profilanswer
 

Tu n'étais pas obligé de tout mettre sur la même feuille pour enlever les .select.
 
Il suffisait par exemple de changer :

Code :
  1. Sheets("Redprincipal" ).Select
  2.     nodoRedPrinc = Cells(t, "B" )


 
par

Code :
  1. nodoRedPrinc = Sheets("Redprincipal" ).Cells(t, "B" )


 
Pour compter le nombre de données de ton tableau, tout dépend comment est remplie ta feuille.
Toutes les lignes sont remplies depuis la cellule A1 ? y a-t-il des cellules vides dont tu ne veux pas tenir compte ? etc...

n°2209003
lnmex
Posté le 02-11-2013 à 14:26:56  profilanswer
 

Ah merci! je vais voir alors pour enlever les select d'une autre maniere
Oui toutes les cellules sont remplies depuis A2.

n°2209020
Marc L
Posté le 02-11-2013 à 18:51:37  profilanswer
 

 
           Bonjour Inmex,
 
          http://smileys.sur-la-toile.com/repository/Messages/plus-un2.gif  avec Takama13 !   Un bon code n'utilise pas les affreux ralentisseurs  Activate  &  Select  !   Un 'chtit exemple ici …
 
           Penser à la propriété  End  pour trouver la dernière cellule d'une colonne à partir d'une cellule connue.
           Elle correspond à la manipulation clavier  Ctrl + flèche de direction  dans une feuille de calcul.
           Donc si la saisie débute dans la cellule A2 et qu'il n'y a pas de trou dans la colonne,
           Ctrl + flèche bas se positionne sur la dernière saisie de la colonne;  en VBA :  [A2].End(xlDown) …
           Consulter l'aide VBA intégrée concernant cette propriété !
 
           CurrentRegion   est une autre propriété à ne pas négliger, très utile pour travailler avec un bloc de colonnes …
 
           Dans le cas d'une colonne à saisie discontinue, l'astuce consiste à se placer sur la dernière cellule de la colonne puis
           de remonter sur la dernière saisie via Ctrl + flèche haut;  en VBA :  Cells(Rows.Count, 1).End(xlUp) …
 
           Enfin pour accélérer un processus, en dehors de respecter la règle TBTO en évitant ces affreux  Select  & autres ralentisseurs,
 
           mis à part de désactiver
           ◙  le mode de calcul automatique   (voir la propriété Application.Calculation)
           ◙  les procédures évènementielles  (          "            Application.EnableEvents)  
           ◙  le rafraîchissement de l'écran     (          "            Application.ScreenUpdating)
           ◙  si besoin les messages d'alerte   (          "            Application.DisplayAlerts),
 
           il est bien plus rapide de parcourir les données d'une variable tableau au lieu des cellules d'une feuille de calcul !
 
           Une procédure comptant les occurrences de 14 commentaires (doublons) au sein d'une colonne de 60 480 saisies
           nécessite moins de 0,2 seconde à l'aide d'une variable tableau entre autres !
 
           En VBA pour charger dans une variable tableau les saisies en colonne depuis la cellule A2 de la feuille active :
 
           AR = Range("A2", [A2].End(xlDown)).Value …
 
           La variable AR est un tableau à deux dimensions lignes par colonnes comme Cells(de 1 à nb de lignes, de 1 à nb de colonnes).
           Si la dernière saisie est en A100, la variable tableau est déclarée de facto ainsi :  AR(1 à 99, 1 à 1) …
           Il y a bien 99 saisies (lignes 2 à 100) sur une seule colonne …
 
           Voir l'aide de la fonction  UBound  pour connaitre le dernier indice d'un tableau.
 
           Afin de parcourir les cellules via une variable tableau, une boucle classique For Next par exemple :

Code :
  1.     AR = Range("A2", [A2].End(xlDown)).Value
  2.    
  3.     For R& = 1 To UBound(AR)
  4.         If AR(R, 1) > "" Then
  5.         ' traitement ici
  6.         End If
  7.     Next


           Enfin consulter l'aide de l'instruction  Erase  pour libérer la mémoire d'une variable tableau …


Message édité par Marc L le 03-11-2013 à 19:16:38
n°2209022
lnmex
Posté le 02-11-2013 à 18:59:13  profilanswer
 

Merci je vais utiliser tout ca!!  :bounce:


Message édité par lnmex le 02-11-2013 à 19:02:14

Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  macro trop lente - double boucle do while

 

Sujets relatifs
Renseignement macro WordAffichage WHILE
[SQL] [SAS] macro sur tableMacro publication CATIA V6
[C=débutant] Boucle While[Python] Faire une boucle
Boucle infini (VBA)Faire ouvrir Excel par une macro Outlook
[ASP] Do While sur une requête erronée 
Plus de sujets relatifs à : macro trop lente - double boucle do while

Forum MesDiscussions.Net, Version 2010.2
(c) 2000-2011 Doctissimo
Page générée en 0.074 secondes

Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR