macro trop lente - double boucle do while

macro trop lente - double boucle do while - VB/VBA/VBS - Programmation

Marsh Posté le 01-11-2013 à 23:14:16    

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
Reply

Marsh Posté le 01-11-2013 à 23:14:16   

Reply

Marsh Posté le 02-11-2013 à 02:45:14    

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

Reply

Marsh Posté le 02-11-2013 à 04:12:40    

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

Reply

Marsh Posté le 02-11-2013 à 05:45:20    

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

Reply

Marsh Posté le 02-11-2013 à 05:46:37    

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

Reply

Marsh Posté le 02-11-2013 à 10:27:06    

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

Reply

Marsh Posté le 02-11-2013 à 14:26:56    

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

Reply

Marsh Posté le 02-11-2013 à 18:51:37    

 
           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
Reply

Marsh Posté le 02-11-2013 à 18:59:13    

Merci je vais utiliser tout ca!!  :bounce:


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

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed